Instalamos y cargamos las librerías necesarias.
if (!require('ggplot2')) install.packages('ggplot2'); library('ggplot2')
if (!require('dplyr')) install.packages('dplyr'); library('dplyr')
if (!require('GGally')) install.packages('GGally'); library(GGally)
if (!require('DataExplorer')) install.packages("DataExplorer"); library(DataExplorer)
if (!require('dlookr')) install.packages("dlookr"); library(dlookr)
if (!require('tidymodels')) install.packages("tidymodels"); library(tidymodels)
if (!require('flextable')) install.packages("flextable"); library(flextable)
if (!require('corrplot')) install.packages("corrplot"); library(corrplot)
if (!require('textshape')) install.packages("textshape"); library(textshape)
if (!require('stats')) install.packages("stats"); library(stats)
if (!require('FactoMineR')) install.packages("FactoMineR"); library(FactoMineR)
if (!require('factoextra')) install.packages("factoextra"); library(factoextra)
if (!require('cluster')) install.packages('cluster'); library(cluster)
if (!require('dbscan')) install.packages('dbscan'); library('dbscan')
if (!require('amap')) install.packages('amap'); library('amap')
if (!require('DescTools')) install.packages('DescTools', repos='http://cran.us.r-project.org'); library(DescTools)
if (!require('caTools')) install.packages('caTools'); library('caTools')
if (!require('gmodels')) install.packages('gmodels', repos='http://cran.us.r-project.org'); library(gmodels)
if (!require('class')) install.packages('class'); library('class')En Europa, el paro cardiaco es una de las primeras causas de mortalidad y en España fallecen en torno a 100 personas al día por este suceso (https://fundaciondelcorazon.com/prensa/notas-de-prensa/2900-solo-el-30-de-espanoles-sabe-realizar-la-reanimacion-cardio-pulmonar-rcp-.html), esto representa aproximadamente el 31% de las muertes a nivel mundial.
Por esta razón, se han seleccionado dos conjuntos de datos, el primer conjunto (https://www.kaggle.com/fedesoriano/heart-failure-prediction?select=heart.csv) contiene 12 características y el segundo (https://www.kaggle.com/ronitf/heart-disease-uci) contiene 13 características. Aunque el número de características que contienen son distintas, muchas son comunes entre los dos y esto permitirá crear un conjunto de datos más completo.
Los dos conjuntos de datos han sido elegidos por las características que estos contienen, ya que son los parámetros típicos usados en los estudios de problemas del corazón, y es por eso por lo que tras el análisis de estos se puede sacar unas conclusiones bastantes interesantes.
Finalmente, se puede decir que el objetivo buscado es predecir la posibilidad de que una persona tenga un alto riesgo de ser diagnosticado como un paciente cardíaco a través de las diversas características. Para llegar a al objetivo se tiene pensado realizar diversos métodos de análisis para así relacionar las diversas características para obtener unos parámetros finales y así concluir la posibilidad de que una persona tenga o no una enfermedad cardiaca.
A continuación, se van a exponer las diferentes características de los conjuntos de datos.
Del primer conjunto, como se ha mencionado anteriormente tenemos 12 características distintas:
El segundo conjunto de datos tiene las siguientes características:
Como se puede observar, las características de los dos conjuntos de datos que coinciden son:
| Primer conjunto de datos | Segundo conjunto de datos | Significado |
|---|---|---|
| Age | Age | Edad de la persona |
| Sex | Sex | Sexo de la persona |
| ChestPainType | cp | Tipo dolor torácico |
| RestingBP | trestbps | Presión arterial en reposo |
| Cholesterol | chol | colesterol de la persona |
| FastingBS | fbs | Nivel de azúcar en sangre |
| RestingECG | restecg | ECG en reposo |
| MaxHR | thalach | Frecuencia cardíaca máxima |
| ExerciseAngina | exang | Angina inducida por ejercicio |
| Oldpeak | oldpeak | depresión del ST |
| ST_Slope | Slope | pendiente del segmento ST |
| HeartDisease | target | ¿Enfermedad Cardiaca? |
Las únicas características que no se encuentran en el primer conjunto de datos son:
Una vez identificadas las características, cargamos los archivos para un análisis exploratorio del conjunto de datos.
#Cargamos el primer fichero
datos1 <- read.csv('heart.csv')
#Cargamos el segundo fichero
datos2 <- read.csv('heart_1.csv')
#Filas del primer fichero
filas_1 = dim(datos1)[1]
#Filas del segundo fichero
filas_2 = dim(datos2)[1]Ahora vamos a ver las estructura de los juegos de datos
#Verificamos la estructura del primer juego
str(datos1)## 'data.frame': 918 obs. of 12 variables:
## $ Age : int 40 49 37 48 54 39 45 54 37 48 ...
## $ Sex : chr "M" "F" "M" "F" ...
## $ ChestPainType : chr "ATA" "NAP" "ATA" "ASY" ...
## $ RestingBP : int 140 160 130 138 150 120 130 110 140 120 ...
## $ Cholesterol : int 289 180 283 214 195 339 237 208 207 284 ...
## $ FastingBS : int 0 0 0 0 0 0 0 0 0 0 ...
## $ RestingECG : chr "Normal" "Normal" "ST" "Normal" ...
## $ MaxHR : int 172 156 98 108 122 170 170 142 130 120 ...
## $ ExerciseAngina: chr "N" "N" "N" "Y" ...
## $ Oldpeak : num 0 1 0 1.5 0 0 0 0 1.5 0 ...
## $ ST_Slope : chr "Up" "Flat" "Up" "Flat" ...
## $ HeartDisease : int 0 1 0 1 0 0 0 0 1 0 ...#Verificamos la estructura del segundo juego
str(datos2)## 'data.frame': 303 obs. of 14 variables:
## $ ï..age : int 63 37 41 56 57 57 56 44 52 57 ...
## $ sex : int 1 1 0 1 0 1 0 1 1 1 ...
## $ cp : int 3 2 1 1 0 0 1 1 2 2 ...
## $ trestbps: int 145 130 130 120 120 140 140 120 172 150 ...
## $ chol : int 233 250 204 236 354 192 294 263 199 168 ...
## $ fbs : int 1 0 0 0 0 0 0 0 1 0 ...
## $ restecg : int 0 1 0 1 1 1 0 1 1 1 ...
## $ thalach : int 150 187 172 178 163 148 153 173 162 174 ...
## $ exang : int 0 0 0 0 1 0 0 0 0 0 ...
## $ oldpeak : num 2.3 3.5 1.4 0.8 0.6 0.4 1.3 0 0.5 1.6 ...
## $ slope : int 0 0 2 2 2 1 1 2 2 2 ...
## $ ca : int 0 0 0 0 0 0 0 0 0 0 ...
## $ thal : int 1 2 2 2 2 1 2 3 3 2 ...
## $ target : int 1 1 1 1 1 1 1 1 1 1 ...Vamos ahora a sacar estadísticas básicas de los juegos de datos
#Estadísticas básica del primer juego
summary(datos1)## Age Sex ChestPainType RestingBP Cholesterol FastingBS RestingECG MaxHR ExerciseAngina
## Min. :28.00 Length:918 Length:918 Min. : 0.0 Min. : 0.0 Min. :0.0000 Length:918 Min. : 60.0 Length:918
## 1st Qu.:47.00 Class :character Class :character 1st Qu.:120.0 1st Qu.:173.2 1st Qu.:0.0000 Class :character 1st Qu.:120.0 Class :character
## Median :54.00 Mode :character Mode :character Median :130.0 Median :223.0 Median :0.0000 Mode :character Median :138.0 Mode :character
## Mean :53.51 Mean :132.4 Mean :198.8 Mean :0.2331 Mean :136.8
## 3rd Qu.:60.00 3rd Qu.:140.0 3rd Qu.:267.0 3rd Qu.:0.0000 3rd Qu.:156.0
## Max. :77.00 Max. :200.0 Max. :603.0 Max. :1.0000 Max. :202.0
## Oldpeak ST_Slope HeartDisease
## Min. :-2.6000 Length:918 Min. :0.0000
## 1st Qu.: 0.0000 Class :character 1st Qu.:0.0000
## Median : 0.6000 Mode :character Median :1.0000
## Mean : 0.8874 Mean :0.5534
## 3rd Qu.: 1.5000 3rd Qu.:1.0000
## Max. : 6.2000 Max. :1.0000#Estadísticas básica del segundo juego
summary(datos2)## ï..age sex cp trestbps chol fbs restecg thalach exang oldpeak
## Min. :29.00 Min. :0.0000 Min. :0.000 Min. : 94.0 Min. :126.0 Min. :0.0000 Min. :0.0000 Min. : 71.0 Min. :0.0000 Min. :0.00
## 1st Qu.:47.50 1st Qu.:0.0000 1st Qu.:0.000 1st Qu.:120.0 1st Qu.:211.0 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:133.5 1st Qu.:0.0000 1st Qu.:0.00
## Median :55.00 Median :1.0000 Median :1.000 Median :130.0 Median :240.0 Median :0.0000 Median :1.0000 Median :153.0 Median :0.0000 Median :0.80
## Mean :54.37 Mean :0.6832 Mean :0.967 Mean :131.6 Mean :246.3 Mean :0.1485 Mean :0.5281 Mean :149.6 Mean :0.3267 Mean :1.04
## 3rd Qu.:61.00 3rd Qu.:1.0000 3rd Qu.:2.000 3rd Qu.:140.0 3rd Qu.:274.5 3rd Qu.:0.0000 3rd Qu.:1.0000 3rd Qu.:166.0 3rd Qu.:1.0000 3rd Qu.:1.60
## Max. :77.00 Max. :1.0000 Max. :3.000 Max. :200.0 Max. :564.0 Max. :1.0000 Max. :2.0000 Max. :202.0 Max. :1.0000 Max. :6.20
## slope ca thal target
## Min. :0.000 Min. :0.0000 Min. :0.000 Min. :0.0000
## 1st Qu.:1.000 1st Qu.:0.0000 1st Qu.:2.000 1st Qu.:0.0000
## Median :1.000 Median :0.0000 Median :2.000 Median :1.0000
## Mean :1.399 Mean :0.7294 Mean :2.314 Mean :0.5446
## 3rd Qu.:2.000 3rd Qu.:1.0000 3rd Qu.:3.000 3rd Qu.:1.0000
## Max. :2.000 Max. :4.0000 Max. :3.000 Max. :1.0000Estadísticas de valores vacíos del primer juego de datos
colSums(is.na(datos1))## Age Sex ChestPainType RestingBP Cholesterol FastingBS RestingECG MaxHR ExerciseAngina Oldpeak ST_Slope
## 0 0 0 0 0 0 0 0 0 0 0
## HeartDisease
## 0colSums(datos1=="")## Age Sex ChestPainType RestingBP Cholesterol FastingBS RestingECG MaxHR ExerciseAngina Oldpeak ST_Slope
## 0 0 0 0 0 0 0 0 0 0 0
## HeartDisease
## 0Estadísticas de valores vacíos del segundo juego de datos
colSums(is.na(datos2))## ï..age sex cp trestbps chol fbs restecg thalach exang oldpeak slope ca thal target
## 0 0 0 0 0 0 0 0 0 0 0 0 0 0colSums(datos2=="")## ï..age sex cp trestbps chol fbs restecg thalach exang oldpeak slope ca thal target
## 0 0 0 0 0 0 0 0 0 0 0 0 0 0Como se puede comprobar, tenemos la “suerte” de no tener ningún valor nulo o vacío en los dos juegos de datos.
Ahora que hemos comprobado que no tenemos valores nulos, se va a proceder a la normalización de los dos conjuntos de datos. La importancia de este proceso es para que a la hora de juntar los dos juegos de datos estén todos en la misma escala de valores y que así se pueda hacer un merge limpio y rápido.
Para la normalización, se hará un análisis de las características comunes comparando una por una de cada uno de los conjuntos de datos. Además, una vez normalizado se analizarán las características para ver posibles valores incorrectos y poder corregirlos.
Como se puede comprobar en las estadísticas del primer conjunto de datos las edades van desde los 28 hasta los 77 años, mientras que en el segundo van desde los 29 hasta los 77 años.
#Histograma de la característica edad del primer conjunto de datos
h1 <- hist(datos1$Age, xlab="Edad", col="ivory", ylab="Cantidad", main="EDAD EN EL PRIMER JUEGO DE DATOS", ylim = c(0, 225), xlim = c(20,80))
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
#Histograma de la característica edad del segundo conjunto de datos
h2 <- hist(datos2$ï..age, xlab="Edad", col="ivory", ylab="Cantidad", main="EDAD EN EL SEGUNDO JUEGO DE DATOS", ylim = c(0, 80), xlim = c(20,80))
text(h2$mids,h2$counts,labels=h2$counts, adj=c(0.5, -0.5))
Como se puede observar, la franja de entre los 50 y 60 años son donde más datos existen, mientras que los extremos donde menos datos.
Una diferencia bastante clara es en la franja de entre los 40 y 45 años, que en el primer conjunto de datos hay un crecimiento de los datos de manera progresiva, mientras que en el segundo existen un crecimiento notable de los datos bastante peculiar en ese rango.
En esta característica observamos que en primer conjunto de datos están identificado con las variables M (hombre) y F (mujer) mientras que en el segundo juego de datos tenemos 1 (hombre) y 0 (mujer).
Entonces se va a normalizar el primer conjunto de datos para que sea como el segundo, vamos a definir el valor 1 para el hombre y el valor 0 para la mujer.
#Cambiamos las letras por los números
datos1$Sex [datos1$Sex == "M"] <- 1
datos1$Sex [datos1$Sex == "F"] <- 0
#Pasamos de carácter a numérico
datos1$Sex <- as.numeric(datos1$Sex)Una vez normalizada la característica , analizamos el conjunto de los datos contemplados en esta.
#Histograma de la característica sexo del primer conjunto de datos
h1 <- hist(datos1$Sex, xlab="Sexo", col=c("ivory", "lightcyan"), ylab="Cantidad", main="SEXO EN EL PRIMER JUEGO DE DATOS", breaks = 2, ylim = c(0, 750), axes = FALSE)
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.25, 0.75), cex.axis=1, labels = c("Mujeres","Hombres" ))
axis(2)
#Histograma de la característica sexo del segundo conjunto de datos
h2 <-hist(datos2$sex, xlab="Sexo", col=c("ivory", "lightcyan"), ylab="Cantidad", main="SEXO EN EL SEGUNDO JUEGO DE DATOS", breaks = 2, ylim = c(0, 250), axes = FALSE)
text(h2$mids,h2$counts,labels=h2$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.25, 0.75), cex.axis=1, labels = c("Mujeres","Hombres" ))
axis(2)
Tras la normalización y la exploración de los datos, nos damos cuenta de que existen mas registros de hombres que de mujeres en los dos conjuntos de datos.
Nos damos cuenta de que el primer conjunto de datos viene identificado por 4 variables categóricas (TA: angina típica, ATA: angina atípica, NAP: dolor no anginal, ASY: asintomático) mientras en el segundo conjunto de datos por valores numérico y cada valor asignado a una causa (valor 0: angina típica, valor 1: angina atípica, valor 2: dolor no anginoso, valor 3: asintomático).
La normalización se hará para el primer conjunto de datos, asignando los valores (que son los del segundo conjunto de datos) de la siguiente manera:
+ 0 = TA
+ 1 = ATA
+ 2 = NAP
+ 3 = ASY#Cambiamos las letras por los números
datos1$ChestPainType [datos1$ChestPainType == "TA"] <- 0
datos1$ChestPainType [datos1$ChestPainType == "ATA"] <- 1
datos1$ChestPainType [datos1$ChestPainType == "NAP"] <- 2
datos1$ChestPainType [datos1$ChestPainType == "ASY"] <- 3
#Pasamos de carácter a numérico
datos1$ChestPainType <- as.numeric(datos1$ChestPainType)Una vez normalizada la característica , analizamos el conjunto de los datos contemplados en esta.
#Histograma de la característica Tipo de dolor torácico del primer conjunto de datos
h1 <- hist(datos1$ChestPainType, xlab="Tipo de dolor torácico", col= c("ivory", "lightcyan", "ORANGE", "PINK"), ylab="Cantidad", main="TIPO DOLOR TORÁCICO EN EL PRIMER JUEGO DE DATOS", ylim = c(0, 550),axes = FALSE, breaks=seq(min(datos1$ChestPainType)-0.5, max(datos1$ChestPainType)+0.5, by=1) )
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
axis(1, at =c(0,1,2,3), cex.axis=1, labels = c("Angina típica", "Angina atípica","Dolor no anginal", "Asintomático" ))
axis(2)
#Histograma de la característica Tipo de dolor torácico del segundo conjunto de datos
h2 <- hist(datos2$cp, xlab="Tipo de dolor torácico", col= c("ivory", "lightcyan", "ORANGE", "PINK"), ylab="Cantidad", main="TIPO DOLOR TORÁCICO EN EL SEGUNDO JUEGO DE DATOS", ylim = c(0, 160),axes = FALSE, breaks=seq(min(datos2$cp)-0.5, max(datos2$cp)+0.5, by=1) )
text(h2$mids,h2$counts,labels=h2$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.2,0.85,1.75,2.75), cex.axis=1, labels = c("Angina típica", "Angina atípica","Dolor no anginal", "Asintomático" ))
axis(2)
Como se puede comprobar, en los dos conjuntos de datos tenemos diversas proporciones del tipo de dolor torácico, lo que supone tener mas variedad a la hora de poder sacar conclusiones.
Como se muestran en las estadísticas esta característica son de tipo numérico y en el primer conjunto de datos va desde 0 hasta 200 y en el segundo de 94 a 200.
Como se puede apreciar, tener una presión arterial de 0 es estar considerado muerto, por lo que considero que el valor 0 es un valor nulo.
Lo primero que se va a hacer es obtener el número de casos que la presión arterial es 0, y se consideraran las diversas formas de tratar estos datos.
#Veces que aparece el valor cero en la presion arterial
length(datos1$RestingBP[datos1$RestingBP == 0])## [1] 1Como solo aparece una vez, se le asignará un valor por defecto. El valor por defecto será el más común.
#Función para calcular el valor más común
common_value <- function(x) {
uniqx <- unique(na.omit(x))
uniqx[which.max(tabulate(match(x, uniqx)))]
}
#Calculamos el valor más comun
BP_comun <- common_value(datos1$RestingBP)
#Asignamos el valor
datos1$RestingBP[datos1$RestingBP == 0] <- BP_comun
#vemos las estaditicas del dato
summary(datos1$RestingBP)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 80.0 120.0 130.0 132.5 140.0 200.0Ahora ya tenemos los valores entre 80 y 200 que son un rango normal para estos valores.
#Histograma de la característica Presión Arterial del primer conjunto de datos
h1 <- hist(datos1$RestingBP, xlab="Presión Arterial", col="ivory", ylab="Cantidad", main="PRESIÓN ARTERIAL EN REPOSO EN EL PRIMER JUEGO DE DATOS", ylim = c(0, 225), xlim = c(80,200))
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
#Histograma de la característica Presión Arterial del segundo conjunto de datos
h1 <- hist(datos2$trestbps, xlab="Presión Arterial", col="ivory", ylab="Cantidad", main="PRESIÓN ARTERIAL EN REPOSO EN EL SEGUNDO JUEGO DE DATOS", ylim = c(0, 100), xlim = c(80,200))
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
Se puede observar que el grueso de los datos está entre 100 y 160 en los dos conjuntos de datos.
La siguiente característica en ambos conjuntos de datos es de tipo numérico. Al igual que en la presión arterial en reposo, en el primer data set tenemos valores 0 que debemos analizar, mientras que en el segundo data set tenemos datos que abarcan desde el 126 hasta 564.
Lo primero que se va a hacer es obtener el numero de casos que el coresterol es 0, y se consideraran las diversas formas de tratar estos datos.
#Veces que aparece el valor cero en la presion arterial
length(datos1$RestingBP[datos1$Cholesterol == 0])## [1] 172Esta vez tenemos 172 casos en lo que ocurre esto (equivale a un 18% de los casos totales). Antes de ver que valor se le asignan, se va a graficar los datos para ver de manera grafica que opción tomar: el valor medio o el más común.
#Histograma de la característica Coresterol del primer conjunto de datos
h1 <- hist(datos1$Cholesterol, xlab="Coresterol", col="ivory", ylab="Cantidad", main="CORESTEROL EN EL PRIMER JUEGO DE DATOS SIN TRATAR NULOS", ylim = c(0,300), xlim = c(0, 700))
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
#Histograma de la característica Coresterol del segundo conjunto de datos
h1 <- hist(datos2$chol, xlab="Coresterol", col="ivory", ylab="Cantidad", main="CORESTEROL EN EL SEGUNDO JUEGO DE DATOS", ylim = c(0,150), xlim = c(0, 700))
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
Tras analizar la gráfica y para no perder estos datos, se le asignaran un valor por defecto, que será la media de los datos. Esta decisión se ha tomado ya que poner el más común, nos crearía un conjunto de datos muy distintos entre unas medidas y otras, mientras que poner la media sería un valor que tenga en cuenta el grueso de todos los datos.
#Calculamos el valor más comun
coresterol_media <- mean(datos1$Cholesterol)
#Asignamos el valor truncado para evitar decimales
datos1$Cholesterol[datos1$Cholesterol == 0] <- trunc(coresterol_media)
#vemos las estaditicas del dato
summary(datos1$RestingBP)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 80.0 120.0 130.0 132.5 140.0 200.0Ahora ya tenemos los valores entre 80 y 200 que son un rango normal para estos valores.
#Histograma de la característica Coresterol del primer conjunto de datos
h1 <- hist(datos1$Cholesterol, xlab="Coresterol", col="ivory", ylab="Cantidad", main="CORESTEROL EN EL PRIMER JUEGO DE DATOS", ylim = c(0,330), xlim = c(0, 700))
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
#Histograma de la característica Coresterol del segundo conjunto de datos
h1 <- hist(datos2$chol, xlab="Coresterol", col="ivory", ylab="Cantidad", main="CORESTEROL EN EL SEGUNDO JUEGO DE DATOS", ylim = c(0,150), xlim = c(0, 700))
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
Como se puede comprobar el conjunto de los datos puedes ser 1 o 0, es decir verdadero o falso si se cumple la siguiente condición: si nivel de azúcar en sangre en ayunas> 120 mg / dl.
En esta característica no tenemos valores nulos, así que vamos a ver la distribución de las dos opciones.
#Histograma de la característica Azúcar en sangre en ayunas del primer conjunto de datos
h1 <- hist(datos1$FastingBS, xlab="¿Azúcar en sangre en ayunas> 120 mg / dl?", col=c("ivory", "lightcyan"), ylab="Cantidad", main="NIVEL DE AZÚCAR EN EL PRIMER JUEGO DE DATOS", breaks = 2, ylim = c(0, 750), axes = FALSE)
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.25, 0.75), cex.axis=1, labels = c("NO","SI" ))
axis(2)
#Histograma de la característica Azúcar en sangre en ayunas del segundo conjunto de datos
h2 <-hist(datos2$fbs, xlab="¿Azúcar en sangre en ayunas> 120 mg / dl?", col=c("ivory", "lightcyan"), ylab="Cantidad", main="NIVEL DE AZÚCAR EN EL SEGUNDO JUEGO DE DATOS", breaks = 2, ylim = c(0, 280), axes = FALSE)
text(h2$mids,h2$counts,labels=h2$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.25, 0.75), cex.axis=1, labels = c("NO","SI" ))
axis(2)
Se puede comprobar que hay mas casos que NO se cumple esa condición de que SÍ.
En el primer conjunto de datos tenemos diferentes parámetros que esta característica puede tomar:
+ Normal: Normal,
+ ST: con anomalía de la onda ST-T
+ LVH: que muestra una hipertrofia ventricular izquierda probable o definitiva según los criterios de Estes.En el segundo conjunto de datos, los diferentes parámetros que esta característica puede tomas son:
+ 0 = normal
+ 1 = con anomalía de la onda ST-T
+ 2 = mostrando hipertrofia ventricular izquierda probable o definitiva según los criterios de Estes.Para normalizar los dos conjuntos de datos, se cambiará los valores del primer conjunto de datos para que sean equivalentes al segundo.
#Cambiamos las letras por los números
datos1$RestingECG [datos1$RestingECG == "Normal"] <- 0
datos1$RestingECG [datos1$RestingECG == "ST"] <- 1
datos1$RestingECG [datos1$RestingECG == "LVH"] <- 2
#Pasamos de carácter a numérico
datos1$RestingECG <- as.numeric(datos1$RestingECG)Una vez normalizada la característica , analizamos el conjunto de los datos contemplados en esta.
#Histograma de la característica ECG en reposo del primer conjunto de datos
h1 <- hist(datos1$RestingECG, xlab="ECG en reposo", col= c("ivory", "lightcyan", "ORANGE"), ylab="Cantidad", main="ECG EN REPOSO EN EL PRIMER JUEGO DE DATOS", ylim = c(0, 600), axes = FALSE, breaks=seq(min(datos1$RestingECG)-0.5, max(datos1$RestingECG)+0.5, by=1) )
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.25, 0.75, 1.75 ), cex.axis=1, labels = c("Normal","ST", "LVH"))
axis(2)
#Histograma de la característica ECG en reposo del segundo conjunto de datos
h1 <- hist(datos2$restecg, xlab="ECG en reposo", col= c("ivory", "lightcyan", "ORANGE"), ylab="Cantidad", main="ECG EN REPOSO EN EL SEGUNDO JUEGO DE DATOS", ylim = c(0, 160), axes = FALSE,breaks=seq(min(datos2$restecg)-0.5, max(datos2$restecg)+0.5, by=1) )
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.25, 0.75, 1.75 ), cex.axis=1, labels = c("Normal","ST", "LVH"))
axis(2)
Como se puede contemplar en el primer conjunto de datos los valores HVI es el segundo grupo con más registros, y en el segundo supone un conjunto muy bajo de todas las muestras mientras que las otras dos opciones están muy igualadas.
Dicha característica es de carácter numérica y en el primer conjunto de datos contempla valores desde el 60 al 202 y en el segundo desde el 71 hasta el 202.
#Histograma de la característica Frecuencia Cardíaca Máxima del primer conjunto de datos
h1 <- hist(datos1$MaxHR, xlab="Frecuencia Cardíaca Máxima", col="ivory", ylab="Cantidad", main="FRECUENCIA CARDÍACA MÁXIMA EN EL PRIMER JUEGO DE DATOS", ylim = c(0,140), axes = FALSE)
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
axis(1, at =c(60, 70, 80,90,100,110,120,130,140,150,160,170,180,190,200,210), cex.axis=1)
axis(2)
#Histograma de la característica Frecuencia Cardíaca Máxima del segundo conjunto de datos
h1 <- hist(datos2$thalach, xlab="Frecuencia Cardíaca Máxima", col="ivory", ylab="Cantidad", main="FRECUENCIA CARDÍACA MÁXIMA EN EL SEGUNDO JUEGO DE DATOS", ylim = c(0,60), axes = FALSE)
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
axis(1, at =c(60, 70, 80,90,100,110,120,130,140,150,160,170,180,190,200,210), cex.axis=1)
axis(2)
Se puede comprobar que los extremos en los dos conjuntos de datos tienen menos valores, y que el grueso de las muestras se encuentran entre los valores centrales (desde 100 a 180).
En el primer conjunto de datos tiene los valores Y: Sí, N: No, mientras que en el segundo 1 = sí; 0 = no.
Al igual que se ha hecho con otras características, se normalizará el primer conjunto a favor del segundo conjunto de datos.
#Cambiamos las letras por los números
datos1$ExerciseAngina [datos1$ExerciseAngina == "N"] <- 0
datos1$ExerciseAngina [datos1$ExerciseAngina == "Y"] <- 1
#Pasamos de carácter a numérico
datos1$ExerciseAngina <- as.numeric(datos1$ExerciseAngina)Una vez normalizada la característica , analizamos el conjunto de los datos contemplados en esta.
#Histograma de la característica Angina inducida por ejercicio del primer conjunto de datos
h1 <- hist(datos1$ExerciseAngina, xlab="¿Angina inducida por ejercicio?", col=c("ivory", "lightcyan"), ylab="Cantidad", main="ANGINA INDUCIDA POR EJERCICIO EN EL PRIMER JUEGO DE DATOS", breaks = 2, ylim = c(0, 600), axes = FALSE)
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.25, 0.75), cex.axis=1, labels = c("NO","SI" ))
axis(2)
#Histograma de la característica Angina inducida por ejercicio del segundo conjunto de datos
h2 <-hist(datos2$exang, xlab="¿Angina inducida por ejercicio?", col=c("ivory", "lightcyan"), ylab="Cantidad", main="ANGINA INDUCIDA POR EJERCICIO EN EL SEGUNDO JUEGO DE DATOS", breaks = 2, ylim = c(0, 220), axes = FALSE)
text(h2$mids,h2$counts,labels=h2$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.25, 0.75), cex.axis=1, labels = c("NO","SI" ))
axis(2)
Como se puede apreciar, hay mas casos en que NO se ha producido una angina inducida por el ejercicio de que Si se haya producido en los dos conjuntos de datos.
Esta característica de tipo numérica puede abarcar valores negativos hasta (en el caso del primer conjunto) hasta un máximo de un valor igual a 6,2 (en ambos conjuntos de datos)
#Histograma de la característica Oldpeak del primer conjunto de datos
h1 <- hist(datos1$Oldpeak, xlab="Oldpeak", col="ivory", ylab="Cantidad", main="OLDPEAK EN EL PRIMER JUEGO DE DATOS", ylim = c(0,400), xlim = c(-4, 8))
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
#Histograma de la característica Oldpeak del segundo conjunto de datos
h1 <- hist(datos2$oldpeak, xlab="Oldpeak", col="ivory", ylab="Cantidad", main="OLDPEAK EN EL SEGUNDO JUEGO DE DATOS", ylim = c(0,150), xlim = c(0, 8))
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
Se puede comprobar que el grueso de las muestras se encuentra entre los valores centrales en el primer caso mientras que en el segundo juego de datos los valores iniciales tienen mas muestras. Observar que en el segundo conjunto tiene rango de valores positivos, mientras que en el primer conjunto de datos abarca un rango mas amplio.
Como ocurría en otras características anteriores cada conjunto de datos los mide de una manera distinta, siendo en el primer conjunto:
+ Up: uploping
+ Flat: flat
+ Down: downslopingY en el segundo conjunto de datos:
+ Valor 0: pendiente ascendente
+ Valor 1: plano
+ Valor 2: pendiente descendenteY como se ha realizado antes, se normalizará el primer conjunto a favor del segundo.
#Cambiamos las letras por los números
datos1$ST_Slope [datos1$ST_Slope == "Up"] <- 0
datos1$ST_Slope [datos1$ST_Slope == "Flat"] <- 1
datos1$ST_Slope [datos1$ST_Slope == "Down"] <- 2
#Pasamos de carácter a numérico
datos1$ST_Slope <- as.numeric(datos1$ST_Slope)Una vez normalizada la característica , analizamos el conjunto de los datos contemplados en esta.
#Histograma de la característica Pendiente del segmento ST del primer conjunto de datos
h1 <- hist(datos1$ST_Slope, xlab="Pendiente del segmento ST", col= c("ivory", "lightcyan", "ORANGE"), ylab="Cantidad", main="PENDIENTE DEL SEGMENTO ST EN EL PRIMER JUEGO DE DATOS", ylim = c(0, 500), axes = FALSE,breaks=seq(min(datos1$ST_Slope)-0.5, max(datos1$ST_Slope)+0.5, by=1) )
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.25, 0.75,1.75), cex.axis=1, labels = c("Ascendente","Plano", "Descendente"))
axis(2)
#Histograma de la característica Pendiente del segmento ST del segundo conjunto de datos
h1 <- hist(datos2$slope, xlab="Pendiente del segmento ST", col= c("ivory", "lightcyan", "ORANGE"), ylab="Cantidad", main="PENDIENTE DEL SEGMENTO ST EN EL SEGUNDO JUEGO DE DATOS", ylim = c(0, 160), axes = FALSE,breaks=seq(min(datos2$slope)-0.5, max(datos2$slope)+0.5, by=1) )
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.25, 0.75,1.75), cex.axis=1, labels = c("Ascendente","Plano", "Descendente"))
axis(2)
El caso más común de ambos conjuntos es que la pendiente sea plana, sin embargo en el primer conjunto la tendencia del segundo caso más común es ascendente y en el segundo conjunto descendente. Esto es bastante bueno ya que nos permite tener una visión mas amplia de todos los tipos de pendientes.
En los dos conjuntos de datos tienen normalizada la salida usando el valor 1: enfermedad cardíaca, y el valor 0: Normal.
#Histograma de la característica¿Enfermedad Cardiaca? del primer conjunto de datos
h1 <- hist(datos1$HeartDisease, xlab="¿Enfermedad Cardiaca?", col=c("ivory", "lightcyan"), ylab="Cantidad", main="¿ENFERMEDAD CARDIACA? EN EL PRIMER JUEGO DE DATOS", breaks = 2, ylim = c(0, 600), axes = FALSE)
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.25, 0.75), cex.axis=1, labels = c("NO","SI" ))
axis(2)
#Histograma de la característica ¿Enfermedad Cardiaca? del segundo conjunto de datos
h2 <-hist(datos2$target, xlab="¿Enfermedad Cardiaca?", col=c("ivory", "lightcyan"), ylab="Cantidad", main="¿ENFERMEDAD CARDIACA? EN EL SEGUNDO JUEGO DE DATOS", breaks = 2, ylim = c(0, 220), axes = FALSE)
text(h2$mids,h2$counts,labels=h2$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.25, 0.75), cex.axis=1, labels = c("NO","SI" ))
axis(2)
Como se puede observar hay mas casos en que SI hay enfermedad cardiaca que caso en los que NO hay.
Antes se ha mencionado que el segundo conjunto tiene dos características presentes que el primer conjunto no tiene. Haciendo un análisis de las estadísticas y la definición de dada al principio de cada una de las dos características, se ha decidió descartarlas por las siguientes razones:
+ Si se quieren tener en cuenta tendremos casi el 75 % de valores nulos.
+ En el caso del numero de vasos afectado (CA) es algo especial para cada caso y no se puede obtener similitudes con otros casos.
+ La Talasemia tampoco se puede calcular la cantidad que tiene a través de otros campos.Una vez que tenemos todas las características de los dos conjuntos con la misma normalización, se va a juntar los dos conjuntos de datos en uno solo.
Lo primero es la normalización de los nombre de las columnas de los dos conjunto de datos
#Obtenemos el nombre de las columnas del primer conjunto de datos
colnames(datos1)## [1] "Age" "Sex" "ChestPainType" "RestingBP" "Cholesterol" "FastingBS" "RestingECG" "MaxHR" "ExerciseAngina"
## [10] "Oldpeak" "ST_Slope" "HeartDisease"#Renombramos las columnas del primer conjunto de datos
colnames(datos1)[1]<- "EDAD"
colnames(datos1)[2]<- "SEXO"
colnames(datos1)[3]<- "TIPO DOLOR TORAX"
colnames(datos1)[4]<- "PRESIÓN ARTERIAL"
colnames(datos1)[5]<- "CORESTEROL"
colnames(datos1)[6]<- "NIVEL DE AZÚCAR"
colnames(datos1)[7]<- "ECG EN REPOSO"
colnames(datos1)[8]<- "FREC CARDÍACA MÁX"
colnames(datos1)[9]<- "ANGINA x EJERCICIO"
colnames(datos1)[10]<- "OLDPEAK"
colnames(datos1)[11]<- "PENDIENTE ST"
colnames(datos1)[12]<- "E. CARDIACA"
#Vemos el nombre de las columnas del primer conjunto de datos
colnames(datos1)## [1] "EDAD" "SEXO" "TIPO DOLOR TORAX" "PRESIÓN ARTERIAL" "CORESTEROL" "NIVEL DE AZÚCAR" "ECG EN REPOSO"
## [8] "FREC CARDÍACA MÁX" "ANGINA x EJERCICIO" "OLDPEAK" "PENDIENTE ST" "E. CARDIACA"#Obtenemos el nombre de las columnas del segundo conjunto de datos
colnames(datos2)## [1] "ï..age" "sex" "cp" "trestbps" "chol" "fbs" "restecg" "thalach" "exang" "oldpeak" "slope" "ca" "thal" "target"#Renombramos las columnas del primer segundo de datos
colnames(datos2)[1]<- "EDAD"
colnames(datos2)[2]<- "SEXO"
colnames(datos2)[3]<- "TIPO DOLOR TORAX"
colnames(datos2)[4]<- "PRESIÓN ARTERIAL"
colnames(datos2)[5]<- "CORESTEROL"
colnames(datos2)[6]<- "NIVEL DE AZÚCAR"
colnames(datos2)[7]<- "ECG EN REPOSO"
colnames(datos2)[8]<- "FREC CARDÍACA MÁX"
colnames(datos2)[9]<- "ANGINA x EJERCICIO"
colnames(datos2)[10]<- "OLDPEAK"
colnames(datos2)[11]<- "PENDIENTE ST"
colnames(datos2)[14]<- "E. CARDIACA"
#Eliminamos las colunmas que no vamos a usar
datos2$ca <- NULL
datos2$thal <- NULL
#Vemos el nombre de las columnas del primer conjunto de datos
colnames(datos2)## [1] "EDAD" "SEXO" "TIPO DOLOR TORAX" "PRESIÓN ARTERIAL" "CORESTEROL" "NIVEL DE AZÚCAR" "ECG EN REPOSO"
## [8] "FREC CARDÍACA MÁX" "ANGINA x EJERCICIO" "OLDPEAK" "PENDIENTE ST" "E. CARDIACA"#Fusionamos los dos conjuntos de datos
datos_final <- merge(x=datos1, y=datos2, all = TRUE)
#Verificamos la estructura del segundo juego
str(datos_final)## 'data.frame': 1221 obs. of 12 variables:
## $ EDAD : int 28 29 29 29 29 30 31 31 32 32 ...
## $ SEXO : num 1 1 1 1 1 0 0 1 0 1 ...
## $ TIPO DOLOR TORAX : num 1 1 1 1 1 0 1 3 1 0 ...
## $ PRESIÓN ARTERIAL : int 130 120 130 130 140 170 100 120 105 95 ...
## $ CORESTEROL : num 132 243 204 204 263 237 219 270 198 198 ...
## $ NIVEL DE AZÚCAR : int 0 0 0 0 0 0 0 0 0 1 ...
## $ ECG EN REPOSO : num 2 0 0 2 0 1 1 0 0 0 ...
## $ FREC CARDÍACA MÁX : int 185 160 202 202 170 170 150 153 165 127 ...
## $ ANGINA x EJERCICIO: num 0 0 0 0 0 0 0 1 0 0 ...
## $ OLDPEAK : num 0 0 0 0 0 0 0 1.5 0 0.7 ...
## $ PENDIENTE ST : num 0 0 2 0 0 0 0 1 0 0 ...
## $ E. CARDIACA : int 0 0 1 0 0 0 0 1 0 1 ...#Estadísticas básicas
summary(datos_final)## EDAD SEXO TIPO DOLOR TORAX PRESIÓN ARTERIAL CORESTEROL NIVEL DE AZÚCAR ECG EN REPOSO FREC CARDÍACA MÁX ANGINA x EJERCICIO
## Min. :28.00 Min. :0.0000 Min. :0.000 Min. : 80.0 Min. : 85.0 Min. :0.0000 Min. :0.0000 Min. : 60 Min. :0.0000
## 1st Qu.:47.00 1st Qu.:1.0000 1st Qu.:1.000 1st Qu.:120.0 1st Qu.:198.0 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:122 1st Qu.:0.0000
## Median :54.00 Median :1.0000 Median :2.000 Median :130.0 Median :228.0 Median :0.0000 Median :0.0000 Median :141 Median :0.0000
## Mean :53.72 Mean :0.7633 Mean :1.933 Mean :132.3 Mean :238.5 Mean :0.2121 Mean :0.5848 Mean :140 Mean :0.3849
## 3rd Qu.:60.00 3rd Qu.:1.0000 3rd Qu.:3.000 3rd Qu.:140.0 3rd Qu.:269.0 3rd Qu.:0.0000 3rd Qu.:1.0000 3rd Qu.:160 3rd Qu.:1.0000
## Max. :77.00 Max. :1.0000 Max. :3.000 Max. :200.0 Max. :603.0 Max. :1.0000 Max. :2.0000 Max. :202 Max. :1.0000
## OLDPEAK PENDIENTE ST E. CARDIACA
## Min. :-2.6000 Min. :0.0000 Min. :0.0000
## 1st Qu.: 0.0000 1st Qu.:0.0000 1st Qu.:0.0000
## Median : 0.6000 Median :1.0000 Median :1.0000
## Mean : 0.9251 Mean :0.8272 Mean :0.5512
## 3rd Qu.: 1.6000 3rd Qu.:1.0000 3rd Qu.:1.0000
## Max. : 6.2000 Max. :2.0000 Max. :1.0000#Comprobar valores nulos
plot_missing(datos_final)
Podemos concluir que el nuevo juego de datos tiene las siguientes características:
Edad: la edad de la persona en años.
Sexo: el sexo de la persona. Los valores que puede tomar son:
Tipo de dolor Torax: tipo de dolor torácico experimentado. Los valores que puede tomar son:
Presión arterial: la presión arterial en reposo de la persona (medido en mm/Hg) al ingreso en el hospital.
Colesterol: colesterol sérico de la persona [medido eb mm/dl]
Nivel de azúcar en sangre: estando el paciente en ayunas. Los valores que puede tomar son dada la siguiente condición <
ECG en reposo: resultados del electrocardiograma en reposo. Los valores que puede tomar son:
Frec cardíaca max: frecuencia cardíaca máxima alcanzada por la persona.
Angina x ejercicio: si se ha producido una angina al realizar ejercicio. Los valores que puede tomar son:
Oldpeak: depresión del ST inducida por el ejercicio en relación con el reposo.
Pendiente ST: la pendiente del segmento ST de ejercicio pico. Los valores que puede tomar son:
¿E. Cardíaca?: si la persona tiene alguna enfermedad cardíaca. Los valores que puede tomar son:
Una vez descrito el nuevo juego de datos, se va a generar histogramas para verificar la distribución de las variables.
library(purrr)
library(tidyr)
library(ggplot2)
datos_final %>%
keep(is.numeric) %>%
gather() %>%
ggplot(aes(value)) +
facet_wrap(~ key, scales = "free") +
geom_histogram(col="red",
fill="green",
alpha = 0.5,) +
ggtitle("Distribuciones de las variables numéricas")
| NOMBRE VARIABLE | DISTRIBUCIÓN | EXPLICACIÓN |
|---|---|---|
| ANGINA x EJERCICIO | Normal | Hay mas casos en que la angina no ha sido inducida por ejercicio |
| CORESTEROL | Sesgado a la derecha | Cifras más “bajas” tienen más registros que cifras más altas |
| E. CARDIACA | Normal | Hay más casos en que se tiene una enfermedad cardiaca |
| ECG EN REPOSO | Sesgado a la derecha | Casos normales tienen mayor peso que con alguna patología |
| EDAD | Normal | Hay más casos en personas con mediana edad que en los extremos |
| FREC CARDÍACA MÁX | Normal | Frecuencia de los datos entre rangos intermedios |
| NIVEL DE AZÚCAR | Sesgado a la derecha | Hay más casos en que se tiene el nivel bien |
| OLDPEAK | Sesgado a la derecha | Existe un grupo con una diferencia bastante grande que con el resto de los datos |
| PENDIENTE ST | Normal | Más casos con pendiente normal que alterada |
| PRESIÓN ARTERIAL | Normal | Frecuencia de los datos entre rangos intermedios |
| SEXO | Sesgado a la izquierda | Hay más pacientes hombres que mujeres |
| TIPO DOLOR TORAX | Sesgado a la izquierda | Hay más casos asintomáticos |
Solo 5 de las doce características tienen una distribución normal, aunque debemos contemplar que alguna de las características está normalizada para tratar dos o tres valores que esas características pueden tener, teniendo en cuenta esto ultimo podemos decir que las únicas dos características que tienen distribuciones distintas son: Colesterol y Oldpeak.
Para comprobar que estamos en los cierto en las dos características con distribución sesgada (Colesterol y Oldpeak) se va a realizar test de normalidad para verificar y con la “función qqnorm” podríamos hacer un Q-Q plot para ver si una variable determinada tiene una distribución normal.
#Colesterol
qqnorm(datos_final$CORESTEROL);qqline(datos_final$CORESTEROL, col = 2)
#Oldpeak
qqnorm(datos_final$OLDPEAK);qqline(datos_final$OLDPEAK, col = 2)
El procedimiento que se puede seguir cuando tenemos una variable que no sigue una distribución normal es la de aplicar el logaritmo a la variable. Lo verificamos de la siguiente manera para las dos características: Colesterol y Oldpeak.
#Coresterol
Coresterol_log<- log(datos_final$CORESTEROL)
ggplot(datos_final, aes(x = Coresterol_log)) + geom_histogram() + xlab("CORESTEROL")
#Oldpeak.
Oldpeak_log<- log(datos_final$OLDPEAK)
ggplot(datos_final, aes(x = Oldpeak_log)) + geom_histogram() + xlab("OLDPEAK")
Observamos como ahora cambia las distribuciones. Lo comprobamos con el Q-Q plot para confirmarlo.
#Colesterol
qqnorm(datos_final$CORESTEROL);qqline(datos_final$CORESTEROL, col = 2)
#Oldpeak
qqnorm(datos_final$OLDPEAK);qqline(datos_final$OLDPEAK, col = 2)
Los test de normalidad no son los esperados, así que se mantendrán estos valores tal y como están. Y continuamos con el análisis exploratorio del nuevo conjunto de datos.
A continuación, se va a representar los niveles de ciertas características en relación con otras
#Relación de la Edad, la Presión arterial y la Frecuencia Cardiaca Máxima.
datos_final %>%
ggplot(aes(x=EDAD,y=`PRESIÓN ARTERIAL`,color=`FREC CARDÍACA MÁX`))+
geom_point(alpha=0.7)+xlab("EDAD") +
ylab("PRESIÓN ARTERIAL")+
ggtitle("Relación de la Edad, la Presión arterial y la Frecuencia Cardiaca Máxima")
#Relación de la Edad, el Coresterol y la Frecuencia Cardiaca máxima.
datos_final %>%
ggplot(aes(x=EDAD,y=CORESTEROL,color=`FREC CARDÍACA MÁX`))+
geom_point(alpha=0.7)+xlab("EDAD") +
ylab("CORESTEROL")+
ggtitle("Relación de la Edad, el Oldpeak y la Frecuencia Cardiaca Máxima")
#Relación de la Edad, el Coresterol y la Frecuencia Cardiaca máxima.
datos_final %>%
ggplot(aes(x=EDAD,y=OLDPEAK,color=`FREC CARDÍACA MÁX`))+
geom_point(alpha=0.7)+xlab("EDAD") +
ylab("OLDPEAK")+
ggtitle("Relación de la Edad, el Oldpeak y la Frecuencia Cardiaca Máxima")
Gracias a estas representaciones se pueden ver las relaciones entre unas características y otras.
Por ultimo se va a mirar a través de los diagramas de cajas el rango de las características enfrentado a si un paciente tiene una enfermedad cardiaca o no.
#Diagrama de caja de todas las características enfrentadas a si un paciente tiene enfermedad cardiaca
plot_boxplot(datos_final, by = "E. CARDIACA")
Una vez realizado el análisis exploratorio, se va a realizar las correlaciones de las características
#Calculamos las correlaciones
cor_datos <- cor(datos_final)
cor_datos## EDAD SEXO TIPO DOLOR TORAX PRESIÓN ARTERIAL CORESTEROL NIVEL DE AZÚCAR ECG EN REPOSO FREC CARDÍACA MÁX ANGINA x EJERCICIO
## EDAD 1.00000000 0.010307251 0.07064056 0.265638310 0.05557662 0.17719557 0.15301742 -0.36737055 0.18478532
## SEXO 0.01030725 1.000000000 0.14393924 -0.006190966 -0.17030775 0.10983323 -0.02065464 -0.17072969 0.18312750
## TIPO DOLOR TORAX 0.07064056 0.143939237 1.00000000 0.035017478 -0.05318981 0.14023978 0.05055787 -0.26539514 0.21247464
## PRESIÓN ARTERIAL 0.26563831 -0.006190966 0.03501748 1.000000000 0.10091912 0.09287163 0.05902914 -0.09833084 0.13454092
## CORESTEROL 0.05557662 -0.170307752 -0.05318981 0.100919123 1.00000000 -0.05485501 0.04623150 0.07215950 0.04545846
## NIVEL DE AZÚCAR 0.17719557 0.109833233 0.14023978 0.092871629 -0.05485501 1.00000000 0.03366667 -0.12336361 0.05888944
## ECG EN REPOSO 0.15301742 -0.020654643 0.05055787 0.059029140 0.04623150 0.03366667 1.00000000 0.03680226 0.02065208
## FREC CARDÍACA MÁX -0.36737055 -0.170729692 -0.26539514 -0.098330842 0.07215950 -0.12336361 0.03680226 1.00000000 -0.37732721
## ANGINA x EJERCICIO 0.18478532 0.183127496 0.21247464 0.134540924 0.04545846 0.05888944 0.02065208 -0.37732721 1.00000000
## OLDPEAK 0.24752994 0.095590850 0.08451111 0.176890078 0.06230374 0.03594124 0.07711587 -0.18634309 0.37165510
## PENDIENTE ST 0.16103760 0.036364404 -0.03765429 0.017546990 0.04571129 0.06589316 0.04976452 -0.04619899 0.19758205
## E. CARDIACA 0.15913980 0.144474318 0.40242504 0.053535720 -0.03116443 0.20237228 0.07378645 -0.20844073 0.27053481
## OLDPEAK PENDIENTE ST E. CARDIACA
## EDAD 0.24752994 0.16103760 0.15913980
## SEXO 0.09559085 0.03636440 0.14447432
## TIPO DOLOR TORAX 0.08451111 -0.03765429 0.40242504
## PRESIÓN ARTERIAL 0.17689008 0.01754699 0.05353572
## CORESTEROL 0.06230374 0.04571129 -0.03116443
## NIVEL DE AZÚCAR 0.03594124 0.06589316 0.20237228
## ECG EN REPOSO 0.07711587 0.04976452 0.07378645
## FREC CARDÍACA MÁX -0.18634309 -0.04619899 -0.20844073
## ANGINA x EJERCICIO 0.37165510 0.19758205 0.27053481
## OLDPEAK 1.00000000 0.21639692 0.18230327
## PENDIENTE ST 0.21639692 1.00000000 0.44099197
## E. CARDIACA 0.18230327 0.44099197 1.00000000#Representación de las correlaciones
corrplot(cor_datos, method = "pie", type="upper")
#Representación de las correlaciones II
corrplot(cor_datos, method = 'shade', order = 'AOE')
#Representación de las correlaciones III
corrplot(cor_datos, method = 'color', order = 'alphabet')
Para representar las correlaciones, se ha usado diferentes métodos para ver las relaciones entre las características y verlo de una manera más clara.
Ahora se va a realizar un análisis de componentes sobre el conjunto de datos final. Lo primero que vamos a calcular es la varianza de todas las caracteristicas
#Cálculo de la varianza de los componentes.
var <- apply(datos_final, 2, var)
var## EDAD SEXO TIPO DOLOR TORAX PRESIÓN ARTERIAL CORESTEROL NIVEL DE AZÚCAR ECG EN REPOSO FREC CARDÍACA MÁX
## 87.4315033 0.1808166 1.2233549 319.6802285 3071.0066876 0.1672628 0.5577678 647.8786644
## ANGINA x EJERCICIO OLDPEAK PENDIENTE ST E. CARDIACA
## 0.2369530 1.1930804 0.4791289 0.2475826Como se puede observar de una manera bastante clara, el colesterol es la característica que mas varia de un individuo a otro.
Lo siguiente es centrar y escalar las características, para que así las variables pierdan esa variabilidad. Una vez calculada la matriz se la asigno al pca
#Calculo de la descomposición de los componentes
pca <- prcomp(datos_final, scale = TRUE, center = TRUE)
pca## Standard deviations (1, .., p=12):
## [1] 1.6004587 1.1848672 1.0951841 1.0481039 0.9890992 0.9745326 0.9269463 0.8877397 0.8482690 0.7815714 0.6725318 0.6153182
##
## Rotation (n x k) = (12 x 12):
## PC1 PC2 PC3 PC4 PC5 PC6 PC7 PC8 PC9 PC10 PC11 PC12
## EDAD 0.34186886 -0.31597048 0.27284093 -0.19719939 0.22036848 -0.03054682 0.394699966 -0.08280293 0.22183975 0.36136298 -0.52567759 -0.04105846
## SEXO 0.19695232 0.41874758 0.10159710 0.15624946 0.27521660 0.29068895 -0.504704790 -0.26613424 0.47328322 0.20038552 -0.03160227 0.01325580
## TIPO DOLOR TORAX 0.29666462 0.35074626 0.05130859 -0.20673459 -0.62151831 -0.01899374 -0.054090760 0.21433908 -0.07062946 0.25414392 -0.13918932 0.46811458
## PRESIÓN ARTERIAL 0.19450631 -0.38116848 0.34117489 -0.12963613 0.09326520 -0.14196344 -0.451908479 0.59104748 0.20098241 -0.19698004 0.14233904 0.04249900
## CORESTEROL -0.00374595 -0.49964402 -0.11013691 0.06643287 -0.48129712 -0.26512415 -0.280661867 -0.51650117 0.25923726 0.10709899 0.08476148 -0.02138766
## NIVEL DE AZÚCAR 0.21033679 0.13463534 0.08129254 -0.55672296 0.28629720 -0.36105881 -0.243445587 -0.39721389 -0.40491044 -0.14495703 0.05220850 0.06338703
## ECG EN REPOSO 0.09336401 -0.24452791 -0.10070730 -0.47737624 -0.12088456 0.77374750 0.032622175 -0.11710842 0.01879421 -0.20963938 0.14467617 0.01221850
## FREC CARDÍACA MÁX -0.38060216 -0.12436986 -0.37924919 -0.14428722 0.06495553 0.08338277 -0.443236654 0.16417138 -0.17641796 0.15005294 -0.62169000 -0.01746038
## ANGINA x EJERCICIO 0.40752387 -0.01395628 0.04453332 0.40393678 -0.13276279 0.08562358 -0.068550323 -0.12478324 -0.18542885 -0.62077660 -0.45065005 -0.02282787
## OLDPEAK 0.34104005 -0.25190114 -0.02266335 0.34168704 0.10252245 0.21743906 -0.169711382 0.02498367 -0.57518714 0.48245931 0.22445107 -0.04209029
## PENDIENTE ST 0.27131324 -0.14004149 -0.64813472 0.06883012 0.31757589 -0.11948995 0.115175138 0.06047606 0.19934936 -0.08228308 0.10069380 0.54153156
## E. CARDIACA 0.40579248 0.17380336 -0.44823765 -0.17158263 -0.13882935 -0.13737285 0.003426377 0.20485733 0.11751791 0.04498669 0.04568829 -0.69045089Se puede ver que la primera componente tiene la mayor desviación estándar de todos los componentes. Para verlo de una manera mas clara, se va a representar de una manera grafica la salida anterior
#Representación PCA´s anteriores
screeplot(pca)
plot(pca, type = "l")
#Juntamos las dos gráficas anteriores
fviz_eig(pca)
Como se ha dicho antes, tanto de una manera numérica como gráfica, el PC1 es el que mejor de todos con una diferencia notable. Si usamos la técnica del codo, deberíamos coger solamente las dos primeras componentes.
Para confirmar la interpretación, no estaría de más obtener las estadísticas de todas las componentes
#Estadísticas de las componentes
summary(pca)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7 PC8 PC9 PC10 PC11 PC12
## Standard deviation 1.6005 1.1849 1.09518 1.04810 0.98910 0.97453 0.9269 0.88774 0.84827 0.7816 0.67253 0.61532
## Proportion of Variance 0.2135 0.1170 0.09995 0.09154 0.08153 0.07914 0.0716 0.06567 0.05996 0.0509 0.03769 0.03155
## Cumulative Proportion 0.2135 0.3305 0.43040 0.52194 0.60347 0.68261 0.7542 0.81989 0.87985 0.9308 0.96845 1.00000Viendo las estadísticas vemos que con las dos primeras componentes solamente podríamos explicar un 33,05% de los datos.Como no queremos perder información en el modelo, nos tendríamos que quedar con todas las componentes.
Para verlo de una manera visual, se va a representar la PCA de una manera gráfica.
#Representación de variables sobre componentes principales
fviz_pca_var(pca, repel = TRUE, scale = 0)
#Representación de observaciones sobre componentes principales
fviz_pca_ind(pca, col.ind = "cos2", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"), repel = TRUE)
#Representa la contribución de filas/columnas de los resultados de un pca
fviz_contrib(pca,choice = "var") 
Una vez que hemos representada las variables y los individuos, se va a fusionar estas dos gráficas
#Representación de variables y los individuos en la misma gráfica
fviz_pca_biplot(pca, repel = TRUE, col.var = "#2E9FDF", col.ind = "#696969")
Aunque la opción de repelerse esta activada al ser bastantes casos no se puede ver una manera correcta, así que se a mostrar solamente los 10, 20 y 30 casos más influyentes
#Representación de variables y los 10 individuos más influyentes en la misma gráfica
fviz_pca_biplot(pca, repel = TRUE, col.var = "#2E9FDF", col.ind = "#696969", select.ind = list(contrib = 10))
#Representación de variables y los 10 individuos más influyentes en la misma gráfica
fviz_pca_biplot(pca, repel = TRUE, col.var = "#2E9FDF", col.ind = "#696969", select.ind = list(contrib = 20))
#Representación de variables y los 10 individuos más influyentes en la misma gráfica
fviz_pca_biplot(pca, repel = TRUE, col.var = "#2E9FDF", col.ind = "#696969", select.ind = list(contrib = 30))
Al mostrar solamente los casos mas influyentes, se puede ver con mas claridad las relaciones entre los individuos y las características.
Podemos concluir de este análisis de componentes, que no se puede quitar ninguna característica ya que se perdería información.
En todos los puntos sucesivos se pide al estudiante, además de aplicar los diferentes métodos, de analizar correctamente el problema, detallar de manera exhaustiva resaltando el por qué y cómo se ha realizado, incluyendo elementos visuales, explicando los resultados, realizar las comparativas oportunas con sus conclusiones.
NOTA: En esta actividad vamos a usar al mismo dataset un método no supervisado y supervisado.
De este modo se pide al estudiante que complete los siguientes pasos:
Aplicar un modelo no supervisado y basado en el concepto de distancia, sobre el juego de datos.
Aplicar de nuevo el modelo anterior, pero usando una métrica distinta y comparar los resultados.
Se aplican lo algoritmos DBSCAN y OPTICS, se prueban con diferentes valores de eps y se comparan los resultados con los métodos anteriores.
Aplicar un modelo de generación de reglas a partir de árboles de decisión ajustando las diferentes opciones de creación como sin y con opciones de poda o boosting y comparar los resultados.
Aplicar un modelo supervisado diferente al anterior a elegir de los vistos en el material docente.Comparar el resultado con el modelo generado anterior.
Identificar eventuales limitaciones del dataset seleccionado y analizar los riesgos para el caso de uso.
El modelo no supervisado basado en distancias que se va a aplicar es el de K-means, la idea fundamental de este algoritmo es agrupar objetos en k grupos basándose en sus características. El agrupamiento se realiza minimizando la suma de distancias entre cada objeto y el centroide de su grupo o clúster.
Antes de nada, se va a crear una copia del juego de datos preparado.
#Creación de la copia de juego de datos
datos_kmeans <- datos_finalInicialmente, es bueno mostrar la distancia entre los datos, por lo que se calcularan y mostraran las distancia.
#Obtenemos las distancias
distance <- get_dist(datos_kmeans)
#Mostramos las distancias de una manera gráfica
fviz_dist(distance, gradient = list(low = "#00AFBB", mid = "white", high = "#FC4E07"))
Una vez mostrada las distancias debemos calcular el numero óptimo de clústeres, como este proceso puede ser bastante confuso y arbitrario, se usarán varios métodos para obtener el numero correcto.
# Método del codo
set.seed(123)
fviz_nbclust(datos_kmeans, kmeans, method = "wss")
# Método de silueta promedio
fviz_nbclust(datos_kmeans, kmeans, method = "silhouette")
Una vez que ya sabemos el número de cluster (k = 2), se va a aplicar el método K-Means a los datos.
#Calculo de la K-means
set.seed(123)
k_mean <- kmeans(datos_kmeans, center = 2, iter.max = 100)
#Centro de los datos
k_mean$centers ## EDAD SEXO TIPO DOLOR TORAX PRESIÓN ARTERIAL CORESTEROL NIVEL DE AZÚCAR ECG EN REPOSO FREC CARDÍACA MÁX ANGINA x EJERCICIO OLDPEAK PENDIENTE ST E. CARDIACA
## 1 54.64802 0.6853147 1.818182 134.9837 296.9184 0.1794872 0.6480186 141.7483 0.4195804 1.0100233 0.8508159 0.5221445
## 2 53.22222 0.8055556 1.994949 130.8510 206.8106 0.2297980 0.5505051 139.0455 0.3661616 0.8791667 0.8143939 0.5669192#Centro de los clusteres
table(k_mean$cluster)##
## 1 2
## 429 792Y podemos representar gráficamente los dos cluster con sus respectivos centroides.
#Representación gráfica
fviz_cluster(k_mean, data = datos_kmeans)
Para facilitar la comprensión, se van a mostrar las estadísticas descriptivas de los clúster.
#Estadísticas Descriptivas
datos_kmeans%>%
mutate(Cluster = k_mean$cluster) %>%
group_by(Cluster) %>%
summarise_all("mean")## # A tibble: 2 x 13
## Cluster EDAD SEXO `TIPO DOLOR TORAX` `PRESIÓN ARTERIAL` CORESTEROL `NIVEL DE AZÚCAR` `ECG EN REPOSO` `FREC CARDÍACA MÁX` `ANGINA x EJERCICIO` OLDPEAK `PENDIENTE ST`
## <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 54.6 0.685 1.82 135. 297. 0.179 0.648 142. 0.420 1.01 0.851
## 2 2 53.2 0.806 1.99 131. 207. 0.230 0.551 139. 0.366 0.879 0.814
## # ... with 1 more variable: E. CARDIACA <dbl>Finalmente, se puede ver que el “dato objetivo” (aunque en métodos no supervisados no existe un campo objetivo, se va a mostrar la división de los clústeres en cuestión de si el paciente tiene o no una enfermedad cardiaca) queda distribuido en los cluster de la siguiente forma:
#Comparación dato objetivo
table(datos_kmeans$`E. CARDIACA`, k_mean$cluster, dnn = c("Original", "cluster" ) )## cluster
## Original 1 2
## 0 205 343
## 1 224 449Comparando los elementos podemos concluir que en los dos grupos hay más o menos el mismo grupo de paciente con enfermedad cardiaca y paciente que no tienen, no obstante se va a calcular la calidad del modelo.
#Calidad del Modelo
d <- daisy(datos_kmeans)
sk <- silhouette(k_mean$cluster, d)
mean(sk[,3])## [1] 0.4077139La calidad de este modelo es del 40,77%
A continuación, se comparará con otros números distintos de clústeres para ver como funciona la clasificación en cada caso.
#Calculamos los modelos
k2 <- k_mean
k3 <- kmeans(datos_kmeans, centers = 3, nstart = 25)
k4 <- kmeans(datos_kmeans, centers = 4, nstart = 25)
k5 <- kmeans(datos_kmeans, centers = 5, nstart = 25)
#Rrepresentamos los modelos
p1 <- fviz_cluster(k2, geom = "point", data = datos_kmeans)+ ggtitle("k = 2")
p2 <- fviz_cluster(k3, geom = "point", data = datos_kmeans)+ ggtitle("k = 3")
p3 <- fviz_cluster(k4, geom = "point", data = datos_kmeans)+ ggtitle("k = 4")
p4 <- fviz_cluster(k5, geom = "point", data = datos_kmeans)+ ggtitle("k = 5")
library(gridExtra)
grid.arrange(p1,p2,p3,p4, nrow = 2)
Para intentar obtener un modelo más fiable, se van a usar solamente las variables con variaciones numéricas, es decir, que no sean variables categóricas convertidas con un valor numérico según el valor. Las variables son: EDAD, PRESION ARTERIAL, CORESTEROL, FREC. CARDIACA MAX y OLDPEAK.
#Creación de la copia del nuevo juego de datos con los campos necesarios
datos_kmeans_2 <- datos_final[,c(1,4,5,8,10)]Como se ha hecho anteriormente, es bueno mostrar la distancia entre los datos, por lo que se calcularan y mostraran las distancia.
#Obtenemos las distancias
distance <- get_dist(datos_kmeans_2)
#Mostramos las distancias de una manera gráfica
fviz_dist(distance, gradient = list(low = "#00AFBB", mid = "white", high = "#FC4E07"))
Una vez mostrada las distancias debemos calcular el numero óptimo de clústeres.
# Método del codo
set.seed(123)
fviz_nbclust(datos_kmeans_2, kmeans, method = "wss")
# Método de silueta promedio
fviz_nbclust(datos_kmeans_2, kmeans, method = "silhouette")
Una vez que ya sabemos el número de cluster (k = 2), se va a aplicar el método K-Means a los datos.
#Calculo de la K-means
set.seed(123)
k_mean <- kmeans(datos_kmeans_2, center = 2, iter.max = 100)
#Centro de los datos
k_mean$centers ## EDAD PRESIÓN ARTERIAL CORESTEROL FREC CARDÍACA MÁX OLDPEAK
## 1 54.64802 134.9837 296.9184 141.7483 1.0100233
## 2 53.22222 130.8510 206.8106 139.0455 0.8791667#Centro de los clusteres
table(k_mean$cluster)##
## 1 2
## 429 792Y podemos representar gráficamente los dos cluster con sus respectivos centroides.
#Representación Gráfica
fviz_cluster(k_mean, data = datos_kmeans_2)
Para facilitar la comprensión, se van a mostrar las estadísticas descriptivas de los clúster.
#Estadísticas
datos_kmeans_2%>%
mutate(Cluster = k_mean$cluster) %>%
group_by(Cluster) %>%
summarise_all("mean")## # A tibble: 2 x 6
## Cluster EDAD `PRESIÓN ARTERIAL` CORESTEROL `FREC CARDÍACA MÁX` OLDPEAK
## <int> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 54.6 135. 297. 142. 1.01
## 2 2 53.2 131. 207. 139. 0.879Y se calcula la calidad del modelo.
#Calidad
d <- daisy(datos_kmeans_2)
sk <- silhouette(k_mean$cluster, d)
mean(sk[,3])## [1] 0.4081857La calidad de este modelo es del 40,81%
Comparando los resultados, la calidad del modelo con todas las variables y con la selección de las variables numérica es prácticamente igual. Por lo que podemos concluir que este tipo de métodos no es bueno para este conjunto de datos, teniendo una calidad bastante baja y no se consigue identificar bien si alguien tiene o no una enfermedad cardiaca.
Para realizar este ejercicio, se ha decidido usar distintas métricas de distancia distintas, para así poder comparar los resultados obtenidos con el modelo obtenido en el ejercicio anterior.
Por defecto, se calculan las distancias por el método de distancia euclidiana, en este caso vamos a probar con las distancias de Manhattan y correlación de Pearson
Además, se van a hacer la comparación con el juego de datos que contienen solo las variables numéricas (las categóricas convertidas a numéricas se eliminaran, como en el segundo modelo del ejercicio anterior).
#Obtenemos las distancias
distance_Manhattan <- get_dist(datos_kmeans_2, method = "manhattan")
#Mostramos las distancias de una manera gráfica
fviz_dist(distance_Manhattan, gradient = list(low = "#00AFBB", mid = "white", high = "#FC4E07"))
Como el número de clústeres son los mismos que en el ejercicio anterior (k =2), no hará falta calcularlos de nuevo, por lo que se va a aplicar el método K-Means a los datos.
#Calculo de la K-means
set.seed(123)
k_mean_Manhattan <- Kmeans(datos_kmeans_2, center = 2, iter.max = 100, method = 'manhattan')
#Centro de los datos
k_mean_Manhattan$centers ## EDAD PRESIÓN ARTERIAL CORESTEROL FREC CARDÍACA MÁX OLDPEAK
## 1 54.71729 135.3411 296.9836 141.7827 1.0189252
## 2 53.18663 130.6633 206.8890 139.0303 0.8745271#Centro de los clusteres
table(k_mean_Manhattan$cluster)##
## 1 2
## 428 793Y podemos representar gráficamente los dos cluster con sus respectivos centroides.
#Graficamos
fviz_cluster(k_mean_Manhattan, data = datos_kmeans_2)
Para facilitar la comprensión, se van a mostrar las estadísticas descriptivas de los clúster.
#Estadísticas
datos_kmeans_2%>%
mutate(Cluster = k_mean_Manhattan$cluster) %>%
group_by(Cluster) %>%
summarise_all("mean")## # A tibble: 2 x 6
## Cluster EDAD `PRESIÓN ARTERIAL` CORESTEROL `FREC CARDÍACA MÁX` OLDPEAK
## <int> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 54.7 135. 297. 142. 1.02
## 2 2 53.2 131. 207. 139. 0.875Y se calcula la calidad del modelo.
#Calidad
d <- daisy(datos_kmeans_2)
sk <- silhouette(k_mean_Manhattan$cluster, d)
mean(sk[,3])## [1] 0.4078561#Obtenemos las distancias
distance_Pearson <- get_dist(datos_kmeans_2, method = "pearson")
#Mostramos las distancias de una manera gráfica
fviz_dist(distance_Pearson, gradient = list(low = "#00AFBB", mid = "white", high = "#FC4E07"))
Como el número de clústeres son los mismos que en el ejercicio anterior (k =2), no hará falta calcularlos de nuevo, por lo que se va a aplicar el método K-Means a los datos.
#Calculo de la K-means
set.seed(123)
library("amap")
k_mean_Pearson <- Kmeans(datos_kmeans_2, center = 2, iter.max = 100, method = 'pearson')
#Centro de los datos
k_mean_Pearson$centers ## EDAD PRESIÓN ARTERIAL CORESTEROL FREC CARDÍACA MÁX OLDPEAK
## 1 54.88650 131.8806 281.2857 131.0431 1.0074364
## 2 52.88592 132.6070 207.6549 146.4380 0.8659155#Centro de los clusteres
table(k_mean_Pearson$cluster)##
## 1 2
## 511 710Y podemos representar gráficamente los dos cluster con sus respectivos centroides.
#Graficamos
fviz_cluster(k_mean_Pearson, data = datos_kmeans_2)
Para facilitar la comprensión, se van a mostrar las estadísticas descriptivas de los clúster.
#Estadísticas
datos_kmeans_2%>%
mutate(Cluster = k_mean_Pearson$cluster) %>%
group_by(Cluster) %>%
summarise_all("mean")## # A tibble: 2 x 6
## Cluster EDAD `PRESIÓN ARTERIAL` CORESTEROL `FREC CARDÍACA MÁX` OLDPEAK
## <int> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 54.9 132. 281. 131. 1.01
## 2 2 52.9 133. 208. 146. 0.866Y se calcula la calidad del modelo.
#Calidad
d <- daisy(datos_kmeans_2)
sk <- silhouette(k_mean_Manhattan$cluster, d)
mean(sk[,3])## [1] 0.4078561Como se puede observar, la calidad de los dos modelos es: 0.4078561 y que no varia mucho de la calidad del modelo anterior.
Por eso, a nivel de conclusión, se puede decir que, aunque el método de k-means no es el mas eficiente para este conjunto de datos, las métricas tampoco han influido mucho en los resultados, por lo que se concluye que este modelo no supervisado no es el mejor para obtener una comparación eficiente del objetivo buscado.
A continuación, se van a utilizar los métodos de clustering DBSCAN y OPTICS que permiten la generación de grupos no radiales a diferencia de K-Means. Lo primero será realizar una copia del juego de datos y seleccionar los numéricos.
#Copia de los datos y los campos que nos interesan
datos_dbscan <- datos_final[,c(1,4,5,8,10)]Una vez tenemos el juego de datos, se va realizar el modelo con un mimPts = 10.
#Creación del modelo
res10 <- optics(datos_dbscan, minPts = 10)
res10## OPTICS ordering/clustering for 1221 objects.
## Parameters: minPts = 10, eps = 189.31729979059, eps_cl = NA, xi = NA
## Available fields: order, reachdist, coredist, predecessor, minPts, eps, eps_cl, xiObtenemos la ordenación de las observaciones o puntos
#Obervaciones ordenadas
res10$order## [1] 1 206 392 493 541 908 907 581 464 431 525 979 1016 1010 1174 1173 1162 987 914 909 851 779 770 1026 1161 1030 993 992 1095 948 1024 905
## [33] 864 860 793 946 816 606 605 540 481 604 704 539 522 497 701 820 699 687 447 445 686 448 971 857 534 1066 869 824 759 709 653 500
## [65] 910 890 542 705 692 1120 1074 648 641 625 616 521 424 655 359 815 997 995 749 724 399 319 406 390 592 1008 986 985 748 904 342 284
## [97] 199 414 302 283 831 1168 1217 1216 1209 1208 1138 1175 896 958 919 747 814 295 760 754 818 1069 861 849 912 848 801 785 642 602 792 791
## [129] 586 549 453 550 609 257 649 446 427 402 761 943 942 1064 1028 941 812 596 569 524 593 598 572 953 931 855 65 1164 895 362 511 1092
## [161] 460 454 258 218 752 700 514 513 231 640 698 673 646 599 527 636 1036 963 758 728 635 543 526 518 495 478 863 835 477 469 451 396
## [193] 395 463 462 450 356 400 375 175 110 349 156 155 307 1163 1154 1035 1020 899 898 756 727 494 468 120 119 1025 807 806 972 961 847 482
## [225] 532 422 308 432 370 369 741 991 990 951 929 794 740 1143 498 133 132 87 150 149 144 137 136 43 1158 459 181 215 223 222 214 180
## [257] 176 56 48 47 84 253 1125 968 1189 1040 872 251 104 213 670 845 844 685 684 681 417 340 484 803 802 483 393 193 167 314 444 587
## [289] 1177 1075 1058 336 603 385 384 374 858 703 401 1105 694 582 506 1076 644 195 381 739 578 311 309 298 279 254 244 337 148 85 61 272
## [321] 271 71 72 60 23 9 398 865 836 612 595 594 575 516 509 397 544 624 623 267 261 243 235 293 252 165 332 496 470 440 439 383
## [353] 382 552 634 633 419 418 347 328 690 911 1031 1018 906 944 928 891 889 821 733 732 702 689 674 632 515 508 589 588 650 461 1157 1097
## [385] 348 1122 734 819 786 735 286 268 306 305 897 294 1170 1169 296 387 380 301 300 208 207 141 115 86 978 126 125 680 679 529 719 718
## [417] 528 334 333 304 303 339 338 177 678 677 200 188 121 355 579 408 259 240 45 250 695 957 409 903 888 361 365 364 358 357 354 346
## [449] 327 217 216 273 551 512 1096 1088 1070 239 238 316 164 163 798 797 489 856 834 465 282 281 804 288 372 34 33 321 320 1144 1134 1023
## [481] 659 404 378 82 81 53 1038 1021 956 933 389 138 1090 501 292 274 1091 1086 811 782 225 224 131 227 226 172 169 154 153 106 591 590
## [513] 142 932 1153 228 210 114 263 262 113 64 345 160 277 276 485 74 62 410 278 537 335 285 1166 1165 1065 1055 1014 1013 955 976 966 939
## [545] 938 111 99 269 1147 194 184 58 647 95 83 643 201 561 560 490 466 38 853 852 810 31 37 29 1029 331 330 762 77 1104 885 879
## [577] 737 736 520 547 190 443 10 49 1187 691 366 256 246 123 122 868 838 805 76 935 324 209 559 558 112 100 667 1156 1155 790 789 377
## [609] 1178 198 197 186 55 54 101 884 883 917 1198 1213 1207 1202 1111 1107 1085 1078 1041 826 808 710 662 379 787 656 628 611 823 545 519 711
## [641] 657 1102 800 799 988 871 230 212 722 717 1103 1204 1201 394 571 105 75 959 921 645 52 974 964 886 880 1052 344 326 1199 683 566 565
## [673] 1152 1151 1050 436 435 934 757 1094 937 915 870 764 729 708 312 658 568 829 767 693 350 325 1005 639 135 134 1093 1087 556 1137 1042 79
## [705] 78 8 950 476 475 287 1072 411 391 780 771 651 438 437 159 12 434 433 1110 1109 1082 1081 918 893 846 669 668 554 553 386 1191 1171
## [737] 116 472 317 310 297 178 93 59 107 945 920 827 788 1196 1195 1190 1182 102 39 30 1112 809 877 1141 1140 1184 1183 1118 1117 707 676 1146
## [769] 1136 601 1068 1071 1057 999 980 970 969 751 574 423 982 538 343 323 795 1037 984 983 580 46 416 721 715 415 229 211 187 158 157 129
## [801] 130 118 318 249 248 192 191 117 57 755 260 247 1032 774 773 555 1049 1048 927 923 425 421 420 412 817 784 564 563 458 430 916 892
## [833] 140 619 1123 1115 1061 1060 1000 629 196 185 1051 1046 925 954 1179 973 962 924 1073 546 457 429 947 600 573 499 242 96 456 428 535 280
## [865] 682 449 182 202 80 63 50 27 26 24 19 203 1012 1011 290 289 270 1180 1167 487 486 480 413 1121 1114 11 221 14 204 189 1022 867
## [897] 441 1039 179 1098 1089 706 675 562 536 517 232 716 162 161 313 1186 1185 171 41 1015 1007 220 219 94 850 894 1211 597 570 523 1132 1127
## [929] 1034 949 654 1206 1205 32 341 151 147 866 837 2 145 108 98 1131 1130 373 351 902 778 769 237 236 36 1212 1100 900 255 245 265 531
## [961] 264 68 67 66 173 631 503 471 492 467 139 124 40 25 18 1119 637 363 1002 1126 1116 1200 69 21 7 168 152 996 745 744 360 1067
## [993] 1056 952 930 661 567 1063 1062 926
## [ reached getOption("max.print") -- omitted 221 entries ]Gráficamente, se representa:
#Graficamos
plot(res10, main="Diagrama de alcanzabilidad", ylab="Distancia", xlab="Orden")
Otra representación del diagrama de alcanzabilidad, se observa en la siguiente imagen que es bastante menos clara.
#Graficamos
plot(datos_dbscan, col = "grey")
polygon(datos_dbscan[res10$order,])
Observando los datos indicados anteriormente, se presenta un eps de 189. Si se selecciona ese valor, quedará un cluster único, por lo que se va a obtener un valor de eps más óptimo.
#Representación con un ESP optimo
kNNdistplot(datos_dbscan, k = 6)
abline(h = 28,lty = 2,col = "red")
Extrayendo un clustering DBSCAN cortando la alcanzabilidad en el valor eps_cl de 28, se tiene:
#Se crea el modelo
db_scan_1 <- extractDBSCAN(res10, eps_cl = 28)
print(db_scan_1)## OPTICS ordering/clustering for 1221 objects.
## Parameters: minPts = 10, eps = 189.31729979059, eps_cl = 28, xi = NA
## The clustering contains 2 cluster(s) and 34 noise points.
##
## 0 1 2
## 34 1176 11
##
## Available fields: order, reachdist, coredist, predecessor, minPts, eps, eps_cl, xi, clusterCuya representación es la que se muestra, viendo como hay 2 clusters con los valores outliers en negro:
#Representación Modelo
plot(db_scan_1, main="Diagrama de alcanzabilidad", ylab="Distancia", xlab="Orden")
Otra posible representación donde se ven los clusters y los outliers, es la siguiente:
#Representación Modelo
hullplot(datos_dbscan, db_scan_1, main = "clusters y outliers")
Repetimos el modelo anterior incrementando el parámetro epc_cl, veamos como el efecto que produce es la concentración de clusters ya que flexibilizamos la condición de densidad.
#Se crea el nuevo modelo
db_scan_2 <- extractDBSCAN(res10, eps_cl = 35)
print(db_scan_2)## OPTICS ordering/clustering for 1221 objects.
## Parameters: minPts = 10, eps = 189.31729979059, eps_cl = 35, xi = NA
## The clustering contains 1 cluster(s) and 14 noise points.
##
## 0 1
## 14 1207
##
## Available fields: order, reachdist, coredist, predecessor, minPts, eps, eps_cl, xi, clusterEsta vez solamente tenemos un único clúster, que representado de manera grafica queda de la siguiente forma:
#Representación Modelo
plot(db_scan_2)
#Representación Modelo
hullplot(datos_dbscan, db_scan_2)
Para validar el agrupamiento, se puede ver cómo están repartidos los datos originales en los diferentes clusters (en el primer caso):
#Tabla comparación datos
table(datos_final$`E. CARDIACA`, db_scan_1$cluster, dnn = c("Original", "cluster" ) )## cluster
## Original 0 1 2
## 0 12 530 6
## 1 22 646 5Para validar el agrupamiento, se puede ver cómo están repartidos los datos originales en los diferentes clusters (en el segundo caso):
#Tabla comparación datos
table(datos_final$`E. CARDIACA`, db_scan_2$cluster, dnn = c("Original", "cluster" ) )## cluster
## Original 0 1
## 0 6 542
## 1 8 665Se observa que no se obtiene una división bastante eficaz de los casos en que existe o no enfermedad cardiaca. Para mejorar la agrupación se va a modificar, inicialmente, el valor de minPts a 3, ya que existen valores muy juntos.
#Creación del modelo
res3 <- optics(datos_dbscan, minPts = 3)
res3## OPTICS ordering/clustering for 1221 objects.
## Parameters: minPts = 3, eps = 78.2943165242535, eps_cl = NA, xi = NA
## Available fields: order, reachdist, coredist, predecessor, minPts, eps, eps_cl, xiy de manera gráfica:
#Graficamos
kNNdistplot(datos_dbscan, k = 3)
abline(h = 28,lty = 2,col = "red")
#Creación del modelo
db_scan_2 <- extractDBSCAN(res3, eps_cl = 28)
print(db_scan_2)## OPTICS ordering/clustering for 1221 objects.
## Parameters: minPts = 3, eps = 78.2943165242535, eps_cl = 28, xi = NA
## The clustering contains 2 cluster(s) and 17 noise points.
##
## 0 1 2
## 17 1201 3
##
## Available fields: order, reachdist, coredist, predecessor, minPts, eps, eps_cl, xi, clusterEn este caso, aunque tenemos dos clúster, el número de variación de los datos respecto a la distancia de 10 es muy poco significativa. La representación del diagrama de alcanzabilidad en este caso será:
#Representación del modelo
plot(db_scan_2, main="Diagrama de alcanzabilidad", ylab="Distancia", xlab="Orden")
Y la distribución de puntos:
#Representación del modelo
hullplot(datos_dbscan, db_scan_2)
Asimismo, la distribución de datos originales en los diferentes clusters:
#Tabla comparación datos
table(datos_final$`E. CARDIACA`, db_scan_2$cluster, dnn = c("Original", "cluster" ) )## cluster
## Original 0 1 2
## 0 6 540 2
## 1 11 661 1Como se observa, pasa lo mismo que en el caso anterior, no hay distinción notable entre los casos que hay o no enfermedad cardiaca.
La medida de lo bueno que es el agrupamiento se puede calcular obteniendo primero el numero de casos de registros con enfermedad cardiaca y que no tienen enfermedad:
#Conteo de datos
count(datos_final, datos_final$`E. CARDIACA`)## datos_final$`E. CARDIACA` n
## 1 0 548
## 2 1 673Y haciendo una comparación entre todos los casos:
–En el primer caso (res10) tenemos 1175 (530 + 646) casos en el primer cluster y 11 en el segundo. El resto son datos ourliers.
–En el segundo caso (res3) tenemos 1201 casos en el primer cluster y 3 en el segundo. El resto son datos ourliers.
En conclusión, este modelo al igual que los dos anteriores no son eficaces para este conjunto de datos, en este caso en concreto la distancia que hay entre los datos no es tan influyente como puede ser otro tipos de datos.
Lo primero que debemos hacer, es comprobar los campos más y menos influyente de una manera numérica, se hará unas pruebas estadísticas de significancia, para así determinar si se puede descartar algún campo. Para ellos se mirarán las proporciones, y luego se calculará los coeficientes V de Cramér y Phi.
#Campo EDAD
tabla_aux <- table(datos_final$EDAD,datos_final$`E. CARDIACA`)
prop.table(tabla_aux, margin = 1)##
## 0 1
## 28 1.0000000 0.0000000
## 29 0.7500000 0.2500000
## 30 1.0000000 0.0000000
## 31 0.5000000 0.5000000
## 32 0.6000000 0.4000000
## 33 0.5000000 0.5000000
## 34 0.5555556 0.4444444
## 35 0.6000000 0.4000000
## 36 0.6666667 0.3333333
## 37 0.7692308 0.2307692
## 38 0.3157895 0.6842105
## 39 0.7368421 0.2631579
## 40 0.5625000 0.4375000
## 41 0.5588235 0.4411765
## 42 0.6153846 0.3846154
## 43 0.5000000 0.5000000
## 44 0.5333333 0.4666667
## 45 0.6538462 0.3461538
## 46 0.4516129 0.5483871
## 47 0.4166667 0.5833333
## 48 0.5000000 0.5000000
## 49 0.4615385 0.5384615
## 50 0.4375000 0.5625000
## 51 0.4893617 0.5106383
## 52 0.4285714 0.5714286
## 53 0.4878049 0.5121951
## 54 0.5074627 0.4925373
## 55 0.4489796 0.5510204
## 56 0.3877551 0.6122449
## 57 0.4000000 0.6000000
## 58 0.4262295 0.5737705
## 59 0.4285714 0.5714286
## 60 0.3720930 0.6279070
## 61 0.3076923 0.6923077
## 62 0.3695652 0.6304348
## 63 0.3333333 0.6666667
## 64 0.3437500 0.6562500
## 65 0.3448276 0.6551724
## 66 0.4500000 0.5500000
## 67 0.3750000 0.6250000
## 68 0.4285714 0.5714286
## 69 0.2500000 0.7500000
## 70 0.3636364 0.6363636
## 71 0.3750000 0.6250000
## 72 0.2500000 0.7500000
## 73 0.0000000 1.0000000
## 74 0.2500000 0.7500000
## 75 0.3333333 0.6666667
## 76 0.3333333 0.6666667
## 77 0.3333333 0.6666667Phi(tabla_aux)## [1] 0.2065394CramerV(tabla_aux) ## [1] 0.2065394El tipo de asociación es baja, por lo que se descarta el campo.
#Campo SEXO
tabla_aux <- table(datos_final$SEXO ,datos_final$`E. CARDIACA`)
prop.table(tabla_aux, margin = 1)##
## 0 1
## 0 0.5778547 0.4221453
## 1 0.4087983 0.5912017Phi(tabla_aux)## [1] 0.1444743CramerV(tabla_aux) ## [1] 0.1444743El tipo de asociación es baja, por lo que se descarta el campo.
#Campo TIPO DOLOR TORAX
tabla_aux <- table(datos_final$`TIPO DOLOR TORAX` ,datos_final$`E. CARDIACA`)
prop.table(tabla_aux, margin = 1)##
## 0 1
## 0 0.6878307 0.3121693
## 1 0.7085202 0.2914798
## 2 0.5137931 0.4862069
## 3 0.2138728 0.7861272Phi(tabla_aux)## [1] 0.4294639CramerV(tabla_aux) ## [1] 0.4294639El tipo de asociación es media, por lo que se deja el campo.
#Campo PRESIÓN ARTERIAL
tabla_aux <- table(datos_final$`PRESIÓN ARTERIAL` ,datos_final$`E. CARDIACA`)
prop.table(tabla_aux, margin = 1)##
## 0 1
## 80 1.0000000 0.0000000
## 92 0.0000000 1.0000000
## 94 0.5000000 0.5000000
## 95 0.0000000 1.0000000
## 96 0.0000000 1.0000000
## 98 1.0000000 0.0000000
## 100 0.5263158 0.4736842
## 101 0.5000000 0.5000000
## 102 0.4000000 0.6000000
## 104 0.5000000 0.5000000
## 105 0.3333333 0.6666667
## 106 0.5000000 0.5000000
## 108 0.5384615 0.4615385
## 110 0.4805195 0.5194805
## 112 0.4782609 0.5217391
## 113 1.0000000 0.0000000
## 114 0.6666667 0.3333333
## 115 0.1818182 0.8181818
## 116 0.0000000 1.0000000
## 117 0.5000000 0.5000000
## 118 0.4705882 0.5294118
## 120 0.5352941 0.4647059
## 122 0.3125000 0.6875000
## 123 0.6666667 0.3333333
## 124 0.5000000 0.5000000
## 125 0.4250000 0.5750000
## 126 0.5000000 0.5000000
## 127 0.0000000 1.0000000
## 128 0.4333333 0.5666667
## 129 0.5000000 0.5000000
## 130 0.5129870 0.4870130
## 131 0.2500000 0.7500000
## 132 0.6000000 0.4000000
## 133 0.5000000 0.5000000
## 134 0.4375000 0.5625000
## 135 0.3461538 0.6538462
## 136 0.3125000 0.6875000
## 137 0.0000000 1.0000000
## 138 0.4333333 0.5666667
## 139 0.4000000 0.6000000
## 140 0.4820144 0.5179856
## 141 0.0000000 1.0000000
## 142 0.3571429 0.6428571
## 143 0.0000000 1.0000000
## 144 0.2000000 0.8000000
## 145 0.3043478 0.6956522
## 146 0.3333333 0.6666667
## 148 0.5000000 0.5000000
## 150 0.4583333 0.5416667
## 152 0.5000000 0.5000000
## 154 0.5000000 0.5000000
## 155 0.3333333 0.6666667
## 156 0.3333333 0.6666667
## 158 0.0000000 1.0000000
## 160 0.3606557 0.6393443
## 164 0.5000000 0.5000000
## 165 0.3333333 0.6666667
## 170 0.3333333 0.6666667
## 172 0.3333333 0.6666667
## 174 0.5000000 0.5000000
## 178 0.4000000 0.6000000
## 180 0.5333333 0.4666667
## 185 0.0000000 1.0000000
## 190 0.5000000 0.5000000
## 192 0.5000000 0.5000000
## 200 0.2000000 0.8000000Phi(tabla_aux)## [1] 0.2235984CramerV(tabla_aux) ## [1] 0.2235984El tipo de asociación es baja, por lo que se descarta el campo.
#Campo CORESTEROL
tabla_aux <- table(datos_final$CORESTEROL ,datos_final$`E. CARDIACA`)
prop.table(tabla_aux, margin = 1)##
## 0 1
## 85 1.0000000 0.0000000
## 100 0.5000000 0.5000000
## 110 0.0000000 1.0000000
## 113 0.0000000 1.0000000
## 117 0.0000000 1.0000000
## 123 0.0000000 1.0000000
## 126 0.3333333 0.6666667
## 129 1.0000000 0.0000000
## 131 0.5000000 0.5000000
## 132 1.0000000 0.0000000
## 139 0.5000000 0.5000000
## 141 0.5000000 0.5000000
## 142 0.0000000 1.0000000
## 147 1.0000000 0.0000000
## 149 0.5000000 0.5000000
## 152 0.0000000 1.0000000
## 153 0.0000000 1.0000000
## 156 0.0000000 1.0000000
## 157 0.5000000 0.5000000
## 159 1.0000000 0.0000000
## 160 0.5714286 0.4285714
## 161 1.0000000 0.0000000
## 163 1.0000000 0.0000000
## 164 0.3333333 0.6666667
## 165 1.0000000 0.0000000
## 166 0.6000000 0.4000000
## 167 0.7500000 0.2500000
## 168 0.6666667 0.3333333
## 169 0.6666667 0.3333333
## 170 0.0000000 1.0000000
## 171 0.6666667 0.3333333
## 172 0.3333333 0.6666667
## 173 0.5000000 0.5000000
## 174 0.5000000 0.5000000
## 175 0.4285714 0.5714286
## 176 0.5000000 0.5000000
## 177 0.5000000 0.5000000
## 178 0.5000000 0.5000000
## 179 1.0000000 0.0000000
## 180 0.5000000 0.5000000
## 181 1.0000000 0.0000000
## 182 0.6666667 0.3333333
## 183 0.5000000 0.5000000
## 184 0.8000000 0.2000000
## 185 0.7500000 0.2500000
## 186 0.2857143 0.7142857
## 187 0.6666667 0.3333333
## 188 0.6666667 0.3333333
## 190 0.5000000 0.5000000
## 192 0.5000000 0.5000000
## 193 0.3750000 0.6250000
## 194 1.0000000 0.0000000
## 195 0.7500000 0.2500000
## 196 0.6250000 0.3750000
## 197 0.5384615 0.4615385
## 198 0.1333333 0.8666667
## 199 0.5000000 0.5000000
## 200 0.6000000 0.4000000
## 201 0.5555556 0.4444444
## 202 0.3333333 0.6666667
## 203 0.4000000 0.6000000
## 204 0.4666667 0.5333333
## 205 0.4000000 0.6000000
## 206 0.4000000 0.6000000
## 207 0.6250000 0.3750000
## 208 0.4444444 0.5555556
## 209 0.7142857 0.2857143
## 210 0.4000000 0.6000000
## 211 0.5384615 0.4615385
## 212 0.4545455 0.5454545
## 213 0.5555556 0.4444444
## 214 0.4444444 0.5555556
## 215 0.8571429 0.1428571
## 216 0.3636364 0.6363636
## 217 0.4000000 0.6000000
## 218 0.5000000 0.5000000
## 219 0.4545455 0.5454545
## 220 0.6153846 0.3846154
## 221 0.4285714 0.5714286
## 222 0.3750000 0.6250000
## 223 0.4615385 0.5384615
## 224 0.7142857 0.2857143
## 225 0.5555556 0.4444444
## 226 0.4000000 0.6000000
## 227 0.6666667 0.3333333
## 228 0.4285714 0.5714286
## 229 0.5714286 0.4285714
## 230 0.5833333 0.4166667
## 231 0.3750000 0.6250000
## 232 0.4000000 0.6000000
## 233 0.4000000 0.6000000
## 234 0.4615385 0.5384615
## 235 0.5714286 0.4285714
## 236 0.4444444 0.5555556
## 237 0.4285714 0.5714286
## 238 1.0000000 0.0000000
## 239 0.5000000 0.5000000
## 240 0.6666667 0.3333333
## 241 0.6000000 0.4000000
## 242 0.3333333 0.6666667
## 243 0.5454545 0.4545455
## 244 0.4285714 0.5714286
## 245 0.5555556 0.4444444
## 246 0.4545455 0.5454545
## 247 0.4000000 0.6000000
## 248 0.2500000 0.7500000
## 249 0.6250000 0.3750000
## 250 0.6250000 0.3750000
## 251 1.0000000 0.0000000
## 252 0.5000000 0.5000000
## 253 0.6666667 0.3333333
## 254 0.5625000 0.4375000
## 255 0.4000000 0.6000000
## 256 0.5000000 0.5000000
## 257 0.5000000 0.5000000
## 258 0.4000000 0.6000000
## 259 0.6666667 0.3333333
## 260 0.5000000 0.5000000
## 261 0.4000000 0.6000000
## 262 0.5000000 0.5000000
## 263 0.4545455 0.5454545
## 264 0.3750000 0.6250000
## 265 0.3333333 0.6666667
## 266 0.5000000 0.5000000
## 267 0.2857143 0.7142857
## 268 0.4285714 0.5714286
## 269 0.5454545 0.4545455
## 270 0.3750000 0.6250000
## 271 0.6666667 0.3333333
## 272 0.6666667 0.3333333
## 273 0.5714286 0.4285714
## 274 0.5555556 0.4444444
## 275 0.5555556 0.4444444
## 276 0.6000000 0.4000000
## 277 0.4285714 0.5714286
## 278 0.5000000 0.5000000
## 279 0.0000000 1.0000000
## 280 0.5000000 0.5000000
## 281 0.5000000 0.5000000
## 282 0.3636364 0.6363636
## 283 0.6250000 0.3750000
## 284 0.6000000 0.4000000
## 285 0.0000000 1.0000000
## 286 0.5000000 0.5000000
## 287 0.5000000 0.5000000
## 288 0.3333333 0.6666667
## 289 0.3750000 0.6250000
## 290 0.3333333 0.6666667
## 291 0.3333333 0.6666667
## 292 0.5000000 0.5000000
## 293 0.5000000 0.5000000
## 294 0.5000000 0.5000000
## 295 0.5714286 0.4285714
## 297 0.7500000 0.2500000
## 298 0.5714286 0.4285714
## 299 0.5000000 0.5000000
## 300 0.3333333 0.6666667
## 302 0.5000000 0.5000000
## 303 0.4285714 0.5714286
## 304 0.5000000 0.5000000
## 305 0.4000000 0.6000000
## 306 0.2500000 0.7500000
## 307 0.6666667 0.3333333
## 308 0.6250000 0.3750000
## 309 0.5714286 0.4285714
## 310 0.3333333 0.6666667
## 311 0.3333333 0.6666667
## 312 0.5000000 0.5000000
## 313 0.5000000 0.5000000
## 315 0.6000000 0.4000000
## 316 0.0000000 1.0000000
## 318 0.6000000 0.4000000
## 319 0.5000000 0.5000000
## 320 1.0000000 0.0000000
## 321 0.5000000 0.5000000
## 322 0.5000000 0.5000000
## 325 0.5000000 0.5000000
## 326 0.6666667 0.3333333
## 327 0.5000000 0.5000000
## 328 1.0000000 0.0000000
## 329 0.0000000 1.0000000
## 330 0.5000000 0.5000000
## 331 0.0000000 1.0000000
## 333 0.0000000 1.0000000
## 335 0.5000000 0.5000000
## 336 0.0000000 1.0000000
## 337 0.0000000 1.0000000
## 338 0.0000000 1.0000000
## 339 0.5000000 0.5000000
## 340 0.6666667 0.3333333
## 341 0.2500000 0.7500000
## 342 0.2500000 0.7500000
## 344 1.0000000 0.0000000
## 347 1.0000000 0.0000000
## 349 0.0000000 1.0000000
## 353 0.5000000 0.5000000
## 354 0.5000000 0.5000000
## 355 0.0000000 1.0000000
## 358 1.0000000 0.0000000
## 360 0.5000000 0.5000000
## 365 1.0000000 0.0000000
## 369 0.0000000 1.0000000
## 384 0.0000000 1.0000000
## 385 1.0000000 0.0000000
## 388 0.0000000 1.0000000
## 392 0.0000000 1.0000000
## 393 0.0000000 1.0000000
## 394 0.6666667 0.3333333
## 404 0.0000000 1.0000000
## 407 0.5000000 0.5000000
## 409 0.5000000 0.5000000
## 412 1.0000000 0.0000000
## 417 0.5000000 0.5000000
## 458 1.0000000 0.0000000
## 466 0.0000000 1.0000000
## 468 1.0000000 0.0000000
## 491 0.0000000 1.0000000
## 518 0.0000000 1.0000000
## 529 0.0000000 1.0000000
## 564 0.5000000 0.5000000
## 603 0.0000000 1.0000000Phi(tabla_aux)## [1] 0.4081721CramerV(tabla_aux) ## [1] 0.4081721El tipo de asociación es media, por lo que se deja el campo.
#Campo NIVEL DE AZÚCAR
tabla_aux <- table(datos_final$`NIVEL DE AZÚCAR`,datos_final$`E. CARDIACA`)
prop.table(tabla_aux, margin = 1)##
## 0 1
## 0 0.5010395 0.4989605
## 1 0.2548263 0.7451737Phi(tabla_aux)## [1] 0.2023723CramerV(tabla_aux) ## [1] 0.2023723El tipo de asociación es baja, por lo que se descarta el campo.
#Campo ECG EN REPOSO
tabla_aux <- table(datos_final$`ECG EN REPOSO` ,datos_final$`E. CARDIACA`)
prop.table(tabla_aux, margin = 1)##
## 0 1
## 0 0.4949928 0.5050072
## 1 0.3545455 0.6454545
## 2 0.4427083 0.5572917Phi(tabla_aux)## [1] 0.1211095CramerV(tabla_aux) ## [1] 0.1211095El tipo de asociación es baja, por lo que se descarta el campo.
#Campo FREC CARDÍACA MÁX
tabla_aux <- table(datos_final$`FREC CARDÍACA MÁX` ,datos_final$`E. CARDIACA`)
prop.table(tabla_aux, margin = 1)##
## 0 1
## 60 0.0000000 1.0000000
## 63 0.0000000 1.0000000
## 67 0.0000000 1.0000000
## 69 1.0000000 0.0000000
## 70 0.0000000 1.0000000
## 71 0.5000000 0.5000000
## 72 0.0000000 1.0000000
## 73 0.0000000 1.0000000
## 77 0.0000000 1.0000000
## 78 0.0000000 1.0000000
## 80 0.5000000 0.5000000
## 82 0.0000000 1.0000000
## 83 0.0000000 1.0000000
## 84 0.0000000 1.0000000
## 86 0.5000000 0.5000000
## 87 0.0000000 1.0000000
## 88 0.3333333 0.6666667
## 90 0.5000000 0.5000000
## 91 0.0000000 1.0000000
## 92 0.0000000 1.0000000
## 93 0.0000000 1.0000000
## 94 0.0000000 1.0000000
## 95 0.3333333 0.6666667
## 96 0.4444444 0.5555556
## 97 0.5000000 0.5000000
## 98 0.2222222 0.7777778
## 99 0.2500000 0.7500000
## 100 0.4285714 0.5714286
## 102 0.0000000 1.0000000
## 103 0.3333333 0.6666667
## 104 0.0000000 1.0000000
## 105 0.2142857 0.7857143
## 106 0.3333333 0.6666667
## 107 1.0000000 0.0000000
## 108 0.2000000 0.8000000
## 109 0.2857143 0.7142857
## 110 0.3043478 0.6956522
## 111 0.5000000 0.5000000
## 112 0.2666667 0.7333333
## 113 0.1666667 0.8333333
## 114 0.5555556 0.4444444
## 115 0.2631579 0.7368421
## 116 0.5454545 0.4545455
## 117 0.1428571 0.8571429
## 118 0.3846154 0.6153846
## 119 0.0000000 1.0000000
## 120 0.3589744 0.6410256
## 121 0.1666667 0.8333333
## 122 0.2500000 0.7500000
## 123 0.2222222 0.7777778
## 124 0.2000000 0.8000000
## 125 0.3214286 0.6785714
## 126 0.4375000 0.5625000
## 127 0.3333333 0.6666667
## 128 0.2666667 0.7333333
## 129 0.4000000 0.6000000
## 130 0.3783784 0.6216216
## 131 0.4545455 0.5454545
## 132 0.5555556 0.4444444
## 133 0.5714286 0.4285714
## 134 0.4285714 0.5714286
## 135 0.6000000 0.4000000
## 136 0.5000000 0.5000000
## 137 0.8750000 0.1250000
## 138 0.5882353 0.4117647
## 139 0.6250000 0.3750000
## 140 0.4680851 0.5319149
## 141 0.5555556 0.4444444
## 142 0.6500000 0.3500000
## 143 0.4117647 0.5882353
## 144 0.5500000 0.4500000
## 145 0.4444444 0.5555556
## 146 0.6000000 0.4000000
## 147 0.5000000 0.5000000
## 148 0.4285714 0.5714286
## 149 0.2500000 0.7500000
## 150 0.5000000 0.5000000
## 151 0.5555556 0.4444444
## 152 0.5263158 0.4736842
## 153 0.5000000 0.5000000
## 154 0.5294118 0.4705882
## 155 0.5555556 0.4444444
## 156 0.4375000 0.5625000
## 157 0.4166667 0.5833333
## 158 0.5000000 0.5000000
## 159 0.4444444 0.5555556
## 160 0.6764706 0.3235294
## 161 0.5000000 0.5000000
## 162 0.5000000 0.5000000
## 163 0.4736842 0.5263158
## 164 0.6666667 0.3333333
## 165 0.6250000 0.3750000
## 166 0.3750000 0.6250000
## 167 0.6666667 0.3333333
## 168 0.6153846 0.3846154
## 169 0.5000000 0.5000000
## 170 0.6000000 0.4000000
## 171 0.5000000 0.5000000
## 172 0.5882353 0.4117647
## 173 0.4666667 0.5333333
## 174 0.5833333 0.4166667
## 175 0.5384615 0.4615385
## 176 0.5000000 0.5000000
## 177 0.5000000 0.5000000
## 178 0.5454545 0.4545455
## 179 0.5454545 0.4545455
## 180 0.6666667 0.3333333
## 181 0.5000000 0.5000000
## 182 0.4545455 0.5454545
## 184 0.8000000 0.2000000
## 185 0.8000000 0.2000000
## 186 0.5000000 0.5000000
## 187 0.5000000 0.5000000
## 188 0.6666667 0.3333333
## 190 0.6666667 0.3333333
## 192 0.5000000 0.5000000
## 194 0.5000000 0.5000000
## 195 0.5000000 0.5000000
## 202 0.5000000 0.5000000Phi(tabla_aux)## [1] 0.3185611CramerV(tabla_aux) ## [1] 0.3185611El tipo de asociación es media, por lo que se deja el campo.
#Campo ANGINA x EJERCICIO
tabla_aux <- table(datos_final$`ANGINA x EJERCICIO` ,datos_final$`E. CARDIACA`)
prop.table(tabla_aux, margin = 1)##
## 0 1
## 0 0.5552597 0.4447403
## 1 0.2787234 0.7212766Phi(tabla_aux)## [1] 0.2705348CramerV(tabla_aux) ## [1] 0.2705348El tipo de asociación es media, por lo que se deja el campo.
#Campo OLDPEAK
tabla_aux <- table(datos_final$OLDPEAK ,datos_final$`E. CARDIACA`)
prop.table(tabla_aux, margin = 1)##
## 0 1
## -2.6 0.0000000 1.0000000
## -2 0.0000000 1.0000000
## -1.5 0.0000000 1.0000000
## -1.1 1.0000000 0.0000000
## -1 0.0000000 1.0000000
## -0.9 0.0000000 1.0000000
## -0.8 0.0000000 1.0000000
## -0.7 0.0000000 1.0000000
## -0.5 0.5000000 0.5000000
## -0.1 1.0000000 0.0000000
## 0 0.5760171 0.4239829
## 0.1 0.5714286 0.4285714
## 0.2 0.6176471 0.3823529
## 0.3 0.6428571 0.3571429
## 0.4 0.5000000 0.5000000
## 0.5 0.3333333 0.6666667
## 0.6 0.5000000 0.5000000
## 0.7 0.2500000 0.7500000
## 0.8 0.4827586 0.5172414
## 0.9 0.4285714 0.5714286
## 1 0.3600000 0.6400000
## 1.1 0.2222222 0.7777778
## 1.2 0.3953488 0.6046512
## 1.3 0.2500000 0.7500000
## 1.4 0.4193548 0.5806452
## 1.5 0.2068966 0.7931034
## 1.6 0.4444444 0.5555556
## 1.7 0.0000000 1.0000000
## 1.8 0.3703704 0.6296296
## 1.9 0.4166667 0.5833333
## 2 0.2470588 0.7529412
## 2.1 0.3333333 0.6666667
## 2.2 0.4444444 0.5555556
## 2.3 0.5000000 0.5000000
## 2.4 0.4285714 0.5714286
## 2.5 0.1111111 0.8888889
## 2.6 0.4615385 0.5384615
## 2.8 0.4615385 0.5384615
## 2.9 0.5000000 0.5000000
## 3 0.2121212 0.7878788
## 3.1 0.5000000 0.5000000
## 3.2 0.5000000 0.5000000
## 3.4 0.5000000 0.5000000
## 3.5 0.3333333 0.6666667
## 3.6 0.5000000 0.5000000
## 3.7 0.0000000 1.0000000
## 3.8 0.5000000 0.5000000
## 4 0.2727273 0.7272727
## 4.2 0.5000000 0.5000000
## 4.4 0.5000000 0.5000000
## 5 0.0000000 1.0000000
## 5.6 0.5000000 0.5000000
## 6.2 0.5000000 0.5000000Phi(tabla_aux)## [1] 0.301659CramerV(tabla_aux) ## [1] 0.301659El tipo de asociación es media, por lo que se deja el campo.
#Campo PENDIENTE ST
tabla_aux <- table(datos_final$`PENDIENTE ST` ,datos_final$`E. CARDIACA`)
prop.table(tabla_aux, margin = 1)##
## 0 1
## 0 0.7908654 0.2091346
## 1 0.2833333 0.7166667
## 2 0.2390244 0.7609756Phi(tabla_aux)## [1] 0.4953823CramerV(tabla_aux) ## [1] 0.4953823El tipo de asociación es media, por lo que se deja el campo.
Siguiendo los valores de V de Cramer y Phi, los valores entre 0.1 y 0.3 nos indican que la asociación estadística es baja, y entre 0.3 y 0.5 se puede considerar una asociación media. Finalmente, si los valores fueran superiores a 0.5, la asociación estadística entre las variables sería alta.
#Se hace una copia de los datos
datos_CRAMER_PHI_ALTO <- datos_final
#Se elimina los campos
datos_CRAMER_PHI_ALTO$EDAD <- NULL
datos_CRAMER_PHI_ALTO$SEXO <- NULL
datos_CRAMER_PHI_ALTO$`PRESIÓN ARTERIAL` <- NULL
datos_CRAMER_PHI_ALTO$`NIVEL DE AZÚCAR` <- NULL
datos_CRAMER_PHI_ALTO$`ECG EN REPOSO` <- NULL
#Normalizamos el campo Enfermedad
datos_CRAMER_PHI_ALTO$`E. CARDIACA`[datos_CRAMER_PHI_ALTO$`E. CARDIACA` == 1] <- "SI"
datos_CRAMER_PHI_ALTO$`E. CARDIACA`[datos_CRAMER_PHI_ALTO$`E. CARDIACA` == 0] <- "NO"
datos_CRAMER_PHI_ALTO$`E. CARDIACA` <- as.factor(datos_CRAMER_PHI_ALTO$`E. CARDIACA`)
#Renombramos columnas
colnames(datos_CRAMER_PHI_ALTO)[1]<- "TIPO_DOLOR_TORAX"
colnames(datos_CRAMER_PHI_ALTO)[2]<- "CORESTEROL"
colnames(datos_CRAMER_PHI_ALTO)[3]<- "FREC_CARDÍACA_MAX"
colnames(datos_CRAMER_PHI_ALTO)[4]<- "ANGINA_x_EJERCICIO"
colnames(datos_CRAMER_PHI_ALTO)[5]<- "OLDPEAK"
colnames(datos_CRAMER_PHI_ALTO)[6]<- "PENDIENTE_ST"
colnames(datos_CRAMER_PHI_ALTO)[7]<- "E_CARDIACA"Para evitar el error “Error in str2lang(x) :
Ahora para proceder a preparar los datos, la primera cosa que debemos hacer es desordenar los datos.
#Desordenar los campos
set.seed(1)
data_random <- datos_CRAMER_PHI_ALTO[sample(nrow(datos_CRAMER_PHI_ALTO)),]Como debemos dividir el conjunto de datos en dos grupos: entrenamiento y test, y al no existir un conjunto complementario ni proporción fijada, se hará 2/3 de los datos para el entrenamiento y 1/3 de los datos para el test.
La variable por la que clasificaremos es el campo de si la persona tiene o no una enfermedad cardiaca, que está en la última columna. De esta forma, tendremos un conjunto de datos para el entrenamiento y uno para la validación.
#Dividir los campos
set.seed(666)
y <- data_random[,7]
X <- data_random
X[,7] <- NULL De forma dinámica podemos definir una forma de separar los datos en función de un parámetro, en este caso del “split_prop”. Definimos un parámetro que controla el split de forma dinámica en el test.
#Separar los registros
split_prop <- 3
max_split<-floor(nrow(X)/split_prop)
tr_limit <- nrow(X)-max_split
ts_limit <- nrow(X)-max_split+1
trainX <- X[1:tr_limit,]
trainy <- y[1:tr_limit]
testX <- X[(ts_limit+1):nrow(X),]
testy <- y[(ts_limit+1):nrow(X)]En la segunda opción podemos crear directamente un rango utilizando el mismo parámetro anterior.
#Separar los registros
split_prop <- 3
indexes = sample(1:nrow(datos_CRAMER_PHI_ALTO), size=floor(((split_prop-1)/split_prop)*nrow(datos_CRAMER_PHI_ALTO)))
trainX<-X[indexes,]
trainy<-y[indexes]
testX<-X[-indexes,]
testy<-y[-indexes]Al extraer aleatoriamente los datos, se hará un análisis mínimo de los datos para asegurarnos de no obtener clasificadores sesgados por los valores que contiene cada muestra.
En este caso, verificaremos que la proporción de personas con enfermedad es más o menos constante en los dos conjuntos.
#Verificar proporción de los datos
summary(trainX);## TIPO_DOLOR_TORAX CORESTEROL FREC_CARDÍACA_MAX ANGINA_x_EJERCICIO OLDPEAK PENDIENTE_ST
## Min. :0.000 Min. : 85.0 Min. : 60.0 Min. :0.0000 Min. :-2.6000 Min. :0.0000
## 1st Qu.:1.000 1st Qu.:198.0 1st Qu.:121.2 1st Qu.:0.0000 1st Qu.: 0.0000 1st Qu.:0.0000
## Median :2.000 Median :226.0 Median :140.0 Median :0.0000 Median : 0.7000 Median :1.0000
## Mean :1.985 Mean :238.3 Mean :139.4 Mean :0.4042 Mean : 0.9287 Mean :0.8194
## 3rd Qu.:3.000 3rd Qu.:270.0 3rd Qu.:159.0 3rd Qu.:1.0000 3rd Qu.: 1.6000 3rd Qu.:1.0000
## Max. :3.000 Max. :603.0 Max. :202.0 Max. :1.0000 Max. : 6.2000 Max. :2.0000#Verificar proporción del dato objetivo
summary(trainy)## NO SI
## 366 448#Verificar proporción de los datos
summary(testX)## TIPO_DOLOR_TORAX CORESTEROL FREC_CARDÍACA_MAX ANGINA_x_EJERCICIO OLDPEAK PENDIENTE_ST
## Min. :0.000 Min. :123.0 Min. : 72.0 Min. :0.0000 Min. :-2.0000 Min. :0.0000
## 1st Qu.:1.000 1st Qu.:198.5 1st Qu.:122.0 1st Qu.:0.0000 1st Qu.: 0.0000 1st Qu.:0.0000
## Median :2.000 Median :233.0 Median :143.0 Median :0.0000 Median : 0.5000 Median :1.0000
## Mean :1.828 Mean :238.8 Mean :141.1 Mean :0.3464 Mean : 0.9179 Mean :0.8428
## 3rd Qu.:3.000 3rd Qu.:267.0 3rd Qu.:161.0 3rd Qu.:1.0000 3rd Qu.: 1.5000 3rd Qu.:1.0000
## Max. :3.000 Max. :564.0 Max. :202.0 Max. :1.0000 Max. : 4.4000 Max. :2.0000#Verificar proporción del dato objetivo
summary(testy)## NO SI
## 182 225Se puede verificar, que hay aproximadamente la misma proporción en el conjunto de entrenamiento y de test.
Ya que tenemos los conjuntos preparados, se crea el árbol de decisión con los datos de entrenamiento.
#Creamos el arbol y lo mostramos
trainy = as.factor(trainy)
model <- C50::C5.0(trainX, trainy,rules=TRUE)
summary(model)##
## Call:
## C5.0.default(x = trainX, y = trainy, rules = TRUE)
##
##
## C5.0 [Release 2.07 GPL Edition] Mon Jan 03 19:51:50 2022
## -------------------------------
##
## Class specified by attribute `outcome'
##
## Read 814 cases (7 attributes) from undefined.data
##
## Rules:
##
## Rule 1: (184/14, lift 2.0)
## TIPO_DOLOR_TORAX <= 2
## PENDIENTE_ST <= 0
## -> class NO [0.919]
##
## Rule 2: (22/1, lift 2.0)
## TIPO_DOLOR_TORAX <= 0
## FREC_CARDÍACA_MAX <= 124
## PENDIENTE_ST <= 1
## -> class NO [0.917]
##
## Rule 3: (44/4, lift 2.0)
## TIPO_DOLOR_TORAX <= 0
## OLDPEAK > 1.7
## -> class NO [0.891]
##
## Rule 4: (186/20, lift 2.0)
## ANGINA_x_EJERCICIO <= 0
## OLDPEAK <= 0.4
## PENDIENTE_ST <= 0
## -> class NO [0.888]
##
## Rule 5: (60/10, lift 1.8)
## TIPO_DOLOR_TORAX <= 0
## ANGINA_x_EJERCICIO > 0
## -> class NO [0.823]
##
## Rule 6: (3, lift 1.8)
## TIPO_DOLOR_TORAX <= 0
## CORESTEROL > 280
## ANGINA_x_EJERCICIO <= 0
## PENDIENTE_ST > 1
## -> class NO [0.800]
##
## Rule 7: (215/19, lift 1.6)
## TIPO_DOLOR_TORAX > 2
## ANGINA_x_EJERCICIO > 0
## -> class SI [0.908]
##
## Rule 8: (244/31, lift 1.6)
## TIPO_DOLOR_TORAX > 2
## OLDPEAK > 0.4
## -> class SI [0.870]
##
## Rule 9: (534/147, lift 1.3)
## PENDIENTE_ST > 0
## -> class SI [0.724]
##
## Default class: SI
##
##
## Evaluation on training data (814 cases):
##
## Rules
## ----------------
## No Errors
##
## 9 136(16.7%) <<
##
##
## (a) (b) <-classified as
## ---- ----
## 269 97 (a): class NO
## 39 409 (b): class SI
##
##
## Attribute usage:
##
## 94.35% PENDIENTE_ST
## 65.85% TIPO_DOLOR_TORAX
## 58.23% OLDPEAK
## 57.00% ANGINA_x_EJERCICIO
## 2.70% FREC_CARDÍACA_MAX
## 0.37% CORESTEROL
##
##
## Time: 0.0 secsComo se puede observar tenemos 9 reglas, entre las mas influyentes tenemos las siguientes:
– TIPO_DOLOR_TORAX <=2 && PENDIENTE_ST <= 0 –> NO TIENE ENFERMEDAD. Validez: 91,9%.
– TIPO_DOLOR_TORAX <= 0 && PENDIENTE_ST <= 1 && FREC_CARDÍACA_MAX <= 124 –> NO TIENE ENFERMEDAD. Validez: 91,7%.
– TIPO_DOLOR_TORAX <= 0 && OLDPEAK > 1.7 –> NO TIENE ENFERMEDAD. Validez: 89,1%.
– ANGINA_x_EJERCICIO <= 0 && OLDPEAK <= 0.4 && PENDIENTE_ST <= 0 –> NO TIENE ENFERMEDAD. Validez: 88,8%.
– TIPO_DOLOR_TORAX <= 0 && ANGINA_x_EJERCICIO > 0 –> NO TIENE ENFERMEDAD. Validez: 82,3%.
– TIPO_DOLOR_TORAX <= 0 && CORESTEROL > 280 && ANGINA_x_EJERCICIO <= 0 && PENDIENTE_ST > 1 –> NO TIENE ENFERMEDAD. Validez: 80%.
– TIPO_DOLOR_TORAX > 2 && ANGINA_x_EJERCICIO > 0 –> SI TIENE ENFERMEDAD. Validez: 90,8%.
– TIPO_DOLOR_TORAX > 2&& OLDPEAK > 0.4 –> SI TIENE ENFERMEDAD. Validez: 87%.
– PENDIENTE_ST > 0 –> SI TIENE ENFERMEDAD. Validez: 72,4%
A continuación, mostramos el árbol obtenido.
#Se grafica el arbol
model <- C50::C5.0(trainX, trainy)
plot(model)
Una vez tenemos el modelo, podemos comprobar su calidad prediciendo la clase para los datos de prueba que nos hemos reservado al principio.
#Calculo de la precisión
predicted_model <- predict( model, testX, type="class" )
print(sprintf("La precisión del árbol es: %.4f %%",100*sum(predicted_model == testy) / length(predicted_model)))## [1] "La precisión del árbol es: 80.8354 %"Cuando hay pocas clases, la calidad de la predicción se puede analizar mediante una matriz de confusión que identifica los tipos de errores cometidos.
#Matriz de confusión
mat_conf<-table(testy,Predicted=predicted_model)
mat_conf## Predicted
## testy NO SI
## NO 126 56
## SI 22 203Para tener información más completa se usará el paquete gmodels.
#Matriz de confusión completa
CrossTable(testy, predicted_model,prop.chisq = FALSE, prop.c = FALSE, prop.r =FALSE,dnn = c('Reality', 'Prediction'))##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 407
##
##
## | Prediction
## Reality | NO | SI | Row Total |
## -------------|-----------|-----------|-----------|
## NO | 126 | 56 | 182 |
## | 0.310 | 0.138 | |
## -------------|-----------|-----------|-----------|
## SI | 22 | 203 | 225 |
## | 0.054 | 0.499 | |
## -------------|-----------|-----------|-----------|
## Column Total | 148 | 259 | 407 |
## -------------|-----------|-----------|-----------|
##
## Dentro de las opciones que ofrece esta librería, está la opción de trials, que nos permite crear distintos modelos aplicando poda o no.En este caso, le vamos a dar un valor de 3.
#Creación del arbol con trial= 3
trainy = as.factor(trainy)
model <- C50::C5.0(trainX, trainy,rules=TRUE, trial=3)
summary(model)##
## Call:
## C5.0.default(x = trainX, y = trainy, trials = 3, rules = TRUE)
##
##
## C5.0 [Release 2.07 GPL Edition] Mon Jan 03 19:51:51 2022
## -------------------------------
##
## Class specified by attribute `outcome'
##
## Read 814 cases (7 attributes) from undefined.data
##
## ----- Trial 0: -----
##
## Rules:
##
## Rule 0/1: (184/14, lift 2.0)
## TIPO_DOLOR_TORAX <= 2
## PENDIENTE_ST <= 0
## -> class NO [0.919]
##
## Rule 0/2: (22/1, lift 2.0)
## TIPO_DOLOR_TORAX <= 0
## FREC_CARDÍACA_MAX <= 124
## PENDIENTE_ST <= 1
## -> class NO [0.917]
##
## Rule 0/3: (44/4, lift 2.0)
## TIPO_DOLOR_TORAX <= 0
## OLDPEAK > 1.7
## -> class NO [0.891]
##
## Rule 0/4: (186/20, lift 2.0)
## ANGINA_x_EJERCICIO <= 0
## OLDPEAK <= 0.4
## PENDIENTE_ST <= 0
## -> class NO [0.888]
##
## Rule 0/5: (60/10, lift 1.8)
## TIPO_DOLOR_TORAX <= 0
## ANGINA_x_EJERCICIO > 0
## -> class NO [0.823]
##
## Rule 0/6: (3, lift 1.8)
## TIPO_DOLOR_TORAX <= 0
## CORESTEROL > 280
## ANGINA_x_EJERCICIO <= 0
## PENDIENTE_ST > 1
## -> class NO [0.800]
##
## Rule 0/7: (215/19, lift 1.6)
## TIPO_DOLOR_TORAX > 2
## ANGINA_x_EJERCICIO > 0
## -> class SI [0.908]
##
## Rule 0/8: (244/31, lift 1.6)
## TIPO_DOLOR_TORAX > 2
## OLDPEAK > 0.4
## -> class SI [0.870]
##
## Rule 0/9: (534/147, lift 1.3)
## PENDIENTE_ST > 0
## -> class SI [0.724]
##
## Default class: SI
##
## ----- Trial 1: -----
##
## Rules:
##
## Rule 1/1: (225.9/59.9, lift 1.5)
## ANGINA_x_EJERCICIO <= 0
## PENDIENTE_ST <= 0
## -> class NO [0.733]
##
## Rule 1/2: (362.2/98.7, lift 1.4)
## TIPO_DOLOR_TORAX <= 2
## PENDIENTE_ST <= 1
## -> class NO [0.726]
##
## Rule 1/3: (194.8/37.9, lift 1.6)
## TIPO_DOLOR_TORAX > 2
## ANGINA_x_EJERCICIO > 0
## -> class SI [0.802]
##
## Rule 1/4: (244.3/53.9, lift 1.6)
## TIPO_DOLOR_TORAX > 2
## PENDIENTE_ST > 0
## -> class SI [0.777]
##
## Rule 1/5: (133.9/47.9, lift 1.3)
## PENDIENTE_ST > 1
## -> class SI [0.640]
##
## Default class: NO
##
## ----- Trial 2: -----
##
## Rules:
##
## Rule 2/1: (198/40.5, lift 2.1)
## PENDIENTE_ST <= 0
## -> class NO [0.793]
##
## Rule 2/2: (121.9/37, lift 1.9)
## TIPO_DOLOR_TORAX <= 0
## -> class NO [0.693]
##
## Rule 2/3: (426.3/73.5, lift 1.6)
## TIPO_DOLOR_TORAX > 0
## PENDIENTE_ST > 0
## -> class SI [0.826]
##
## Default class: SI
##
##
## Evaluation on training data (814 cases):
##
## Trial Rules
## ----- ----------------
## No Errors
##
## 0 9 136(16.7%)
## 1 5 175(21.5%)
## 2 3 170(20.9%)
## boost 145(17.8%) <<
##
##
## (a) (b) <-classified as
## ---- ----
## 279 87 (a): class NO
## 58 390 (b): class SI
##
##
## Attribute usage:
##
## 100.00% PENDIENTE_ST
## 93.86% TIPO_DOLOR_TORAX
## 62.78% ANGINA_x_EJERCICIO
## 58.23% OLDPEAK
## 2.70% FREC_CARDÍACA_MAX
## 0.37% CORESTEROL
##
##
## Time: 0.0 secsComo se pude comprobar, tenemos ahora mismo 3 modelos distintos. El modelo 0 es el analizado antes, mientras que los otros dos tienen un número menor de reglas. El menor numero de reglas implica que la fiabilidad es menor, es decir se puede ver que en el primer modelo (con 9 reglas) es el que menor porcentaje de error tiene.
Lo que voy a comprobar ahora es la precisión del árbol con todas las variables, ya que se ha descartado la inmensa mayoría.
#Asignamos los datos
set.seed(1)
data_random_completos <- datos_final[sample(nrow(datos_final)),]
#Separamos los valores
set.seed(666)
y_completo <- data_random_completos[,12]
X_completo <- data_random_completos
X_completo[,12] <- NULL
#Separamos los campos
split_prop <- 3
max_split<-floor(nrow(X_completo)/split_prop)
tr_limit <- nrow(X_completo)-max_split
ts_limit <- nrow(X_completo)-max_split+1
trainX <- X_completo[1:tr_limit,]
trainy <- y_completo[1:tr_limit]
testX <- X_completo[(ts_limit+1):nrow(X_completo),]
testy <- y_completo[(ts_limit+1):nrow(X_completo)]
split_prop <- 3
indexes = sample(1:nrow(datos_final), size=floor(((split_prop-1)/split_prop)*nrow(datos_final)))
trainX<-X_completo[indexes,]
trainy<-y_completo[indexes]
testX<-X_completo[-indexes,]
testy<-y_completo[-indexes]
#Se crea el arbol de decisión
trainy = as.factor(trainy)
model <- C50::C5.0(trainX, trainy,rules=TRUE )
#Se obtiene la precision del arbol
predicted_model <- predict( model, testX, type="class" )
print(sprintf("La precisión del árbol con todos los campos es: %.4f %%",100*sum(predicted_model == testy) / length(predicted_model)))## [1] "La precisión del árbol con todos los campos es: 77.1499 %"En este caso, tenemos una predicción un poco mas baja con todas las variables.
Analizando el árbol inicial (con solo las variables seleccionadas) vemos el nivel de precisión en cada una de las reglas, siendo las reglas 1,2 y 7 las mas precisas, en las que comprueba las variables TIPO_DOLOR_TORAX, PENDIENTE_ST, FREC_CARDÍACA_MAX y ANGINA_x_EJERCICIO.
Se puede concluir que la capacidad de predicción del árbol es bastante buena, y que como se ha comprobado un análisis inicial de los campos, pueden ayudar a simplificar mucho la creación del árbol y en este caso mejorar la precisión.
Finalmente, se van a crear otros modelos usando distintos métodos.
Lo primero será realizar una copia del juego de datos.
#Copia de los datos
datos_regresion <- datos_finalUna vez obtenido la copia del conjunto de datos, se van a dividir en dos grupos: Train y Test.
#División datos
set.seed(123)
split = sample.split(datos_regresion$`E. CARDIACA`, SplitRatio = 0.8)
training_set = subset(datos_regresion, split = TRUE)
test_set = subset(datos_regresion, split = FALSE)Escalar los valores numéricos
#Escalado
training_set[ , c(1,4,5,8, 10)] = scale(training_set[, c(1,4,5,8, 10)])
test_set[ , c(1,4,5,8, 10)] = scale(test_set[ , c(1,4,5,8, 10)])Y creamos el modelo
#Creación modelo
classifier = glm(formula = `E. CARDIACA` ~ . ,
family = binomial,
data = training_set)
#Se muestra el modelo
summary(classifier)##
## Call:
## glm(formula = `E. CARDIACA` ~ ., family = binomial, data = training_set)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.0302 -0.6765 0.3242 0.6441 2.6244
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -3.661762 0.264366 -13.851 < 2e-16 ***
## EDAD 0.040845 0.087276 0.468 0.640
## SEXO 0.274229 0.182077 1.506 0.132
## `TIPO DOLOR TORAX` 0.951883 0.073823 12.894 < 2e-16 ***
## `PRESIÓN ARTERIAL` 0.001546 0.080862 0.019 0.985
## CORESTEROL -0.080771 0.076802 -1.052 0.293
## `NIVEL DE AZÚCAR` 0.902187 0.201456 4.478 7.52e-06 ***
## `ECG EN REPOSO` 0.134031 0.102559 1.307 0.191
## `FREC CARDÍACA MÁX` -0.102687 0.088493 -1.160 0.246
## `ANGINA x EJERCICIO` 0.448711 0.176445 2.543 0.011 *
## OLDPEAK 0.072676 0.086026 0.845 0.398
## `PENDIENTE ST` 1.793144 0.124750 14.374 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1679.8 on 1220 degrees of freedom
## Residual deviance: 1102.2 on 1209 degrees of freedom
## AIC: 1126.2
##
## Number of Fisher Scoring iterations: 5Predicción para el conjunto de datos de prueba.
#Predicción
prob_pred = predict(classifier , type = 'response', newdata = test_set[1:12])
y_pred = ifelse(prob_pred > 0.5, 1, 0)
table(test_set[, 12], y_pred)## y_pred
## 0 1
## 0 419 129
## 1 111 562y_pred <- as.factor(y_pred)
test_set[ ,12] = as.factor(test_set[ ,12])
library(caret)
library(e1071)Y vemos el resultado en la Matriz de confusión.
#Matriz de confusión
confusionMatrix(y_pred , test_set$`E. CARDIACA`)## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 419 111
## 1 129 562
##
## Accuracy : 0.8034
## 95% CI : (0.78, 0.8254)
## No Information Rate : 0.5512
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.6015
##
## Mcnemar's Test P-Value : 0.2725
##
## Sensitivity : 0.7646
## Specificity : 0.8351
## Pos Pred Value : 0.7906
## Neg Pred Value : 0.8133
## Prevalence : 0.4488
## Detection Rate : 0.3432
## Detection Prevalence : 0.4341
## Balanced Accuracy : 0.7998
##
## 'Positive' Class : 0
## De la regresión se ha obtenido una precisión del 80,34%, lo que es bastante bueno y es casi similar al modelo anterior de árboles de decisión.
Lo primero será realizar una copia del juego de datos.
#Copia de los datos
datos_knn <- datos_finalUna vez obtenido la copia del conjunto de datos, se van a dividir en dos grupos: Train y Test y preparar los grupos.
#División de los datos
set.seed(123)
samp_size=floor(0.75*nrow(datos_knn))
samp_ind=sample(seq_len(nrow(datos_knn)),size = samp_size)
data_train=datos_knn[samp_ind,-12]
data_test=datos_knn[-samp_ind,-12]
data_train_labels=datos_knn[samp_ind,12]
data_test_labels=datos_knn[-samp_ind,12]Y creamos el modelo
#Creación del modelo
knn=knn(train = data_train,test = data_test,cl=data_train_labels,k=10)Predicción para el conjunto de datos de prueba.
#Predicción
CrossTable(x=data_test_labels,y=data_test_pred,prop.chisq = FALSE)##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Row Total |
## | N / Col Total |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 306
##
##
## | data_test_pred
## data_test_labels | 0 | 1 | Row Total |
## -----------------|-----------|-----------|-----------|
## 0 | 56 | 77 | 133 |
## | 0.421 | 0.579 | 0.435 |
## | 0.483 | 0.405 | |
## | 0.183 | 0.252 | |
## -----------------|-----------|-----------|-----------|
## 1 | 60 | 113 | 173 |
## | 0.347 | 0.653 | 0.565 |
## | 0.517 | 0.595 | |
## | 0.196 | 0.369 | |
## -----------------|-----------|-----------|-----------|
## Column Total | 116 | 190 | 306 |
## | 0.379 | 0.621 | |
## -----------------|-----------|-----------|-----------|
##
## #Matriz de confusión
confusionMatrix(table(data_test_labels,data_test_pred))## Confusion Matrix and Statistics
##
## data_test_pred
## data_test_labels 0 1
## 0 56 77
## 1 60 113
##
## Accuracy : 0.5523
## 95% CI : (0.4947, 0.6089)
## No Information Rate : 0.6209
## P-Value [Acc > NIR] : 0.9940
##
## Kappa : 0.0753
##
## Mcnemar's Test P-Value : 0.1716
##
## Sensitivity : 0.4828
## Specificity : 0.5947
## Pos Pred Value : 0.4211
## Neg Pred Value : 0.6532
## Prevalence : 0.3791
## Detection Rate : 0.1830
## Detection Prevalence : 0.4346
## Balanced Accuracy : 0.5387
##
## 'Positive' Class : 0
## La precisión de este modelo es 55,23% la mas baja de entre todos los modelos supervisados.
A nivel de comparación, se va a mostrar la tabla de todos los modelos:
| MODELO SUPERVISADO | PRECISIÓN |
|---|---|
| ARBOL DE DECISIÓN | 80.83% |
| REGRESIÓN | 80,34% |
| KNN | 55,23% |
Como se puede observar en la tabla anterior, de los 3 modelos creados, dos son prácticamente igual de precisos (arboles de decisión y regresión) y el modelo de KNN ha dado una precisión mas baja.
No obstante, este conjunto de datos estaba pensado para este tipo de modelos supervisados, y se ha conseguido una precisión (a mi juicio) bastante buena.
Entre las limitaciones que podemos encontrar en este conjunto de datos es que desde el principio de todo tenemos una variable objetivo, lo cual descarta casi por completo usar modelos no supervisados. No obstante, se ha confirmado esta conclusión en los distintos modelos no supervisados creados, teniendo una predicción menor al 50%.
Por otro lado, tenemos los modelos supervisados, en donde se han creado 3 modelos distintos y se han obtenido en dos de ellos una precisión superior al 80% y en el restante superior al 50%. Los resultados del conjunto de datos en estos modelos son los esperados, ya que al poseer una variable objetivo el conjunto de datos funciona para este tipo de modelos.
Si quisiéramos usar este modelo para predecir casos reales (a mi juicio) se debería crear un modelo supervisado (árbol de decisión para ver las reglas y así poder y analizarlas para ver si tienen sentido).
Por otro lado, se han obtenido los datos de dos dataset distintos, pero la suma de ellos no supera 1500 registros, por lo que seria bueno obtener más registros a través de otros dataset (y se debería obtener de casos actualizados y de las mismas zonas geográficas).
Además, en el juego de datos finales se ha descartado dos campos de uno de los conjuntos (ya que el conjunto de datos con más registros no poseía esos campos) por lo que podríamos empeorar la predicción al poder ser datos decisivos a la hora de generar el modelo supervisado. Por otro lado, y siguiendo en la misma línea, creo que seria bueno completar el conjunto de datos con mas campos (no solo los descartados, si no con un mayor número) que se consideren relevantes.
Finalmente se debería probar el modelo creado con un medico especializado, para que se comprueben simultáneamente el resultado del modelo y el juicio del médico y así poder comparar y ajustar el modelo. Esta propuesta, además, permitirá generar añadir nuevos datos de forma correcta.
Incluimos en este apartado una lista de recursos de programación para minería de datos donde podréis encontrar ejemplos, ideas e inspiración:
El formato de entrega es: username_estudiante-PRA2 .Rmd y el output generado en uno de estos formatos html/doc/docx/odt/pdf.
Se debe entregar la PRA en el buzón de entregas del aula en formato comprimido que incluye los ficheros: - ejecutable - output - el dataset seleccionado o en su defecto indicar la ruta para su descarga en el ejecutable.
A menudo es inevitable, al producir una obra multimedia, hacer uso de recursos creados por terceras personas. Es por lo tanto comprensible hacerlo en el marco de una práctica de los estudios de Informática, Multimedia y Telecomunicación de la UOC, siempre y cuando esto se documente claramente y no suponga plagio en la práctica.
Por lo tanto, al presentar una práctica que haga uso de recursos ajenos, se debe presentar junto con ella un documento en que se detallen todos ellos, especificando el nombre de cada recurso, su autor, el lugar donde se obtuvo y su estatus legal: si la obra esta protegida por el copyright o se acoge a alguna otra licencia de uso (Creative Commons, licencia GNU, GPL …). El estudiante deberá asegurarse de que la licencia no impide específicamente su uso en el marco de la práctica. En caso de no encontrar la información correspondiente tendrá que asumir que la obra esta protegida por copyright.
Deberéis, además, adjuntar los ficheros originales cuando las obras utilizadas sean digitales, y su código fuente si corresponde.
Para realizar esta práctica se ha usado y analizado distintos códigos proporcionados en la pagina donde se ha obtenidos los datos:
– https://www.kaggle.com/ronitf/heart-disease-uci/code
– https://www.kaggle.com/fedesoriano/heart-failure-prediction/code
Además, se ha usado la documentación oficial de R para ver las distintas funciones y sus prametros.